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ABSTRACT 


A compiler  for  a subset  of  the  Automated  Data  Processing 
Equipment  Selection  Office  (ADPESO)  3YP0-C030L  has  been 
implemented  on  a microcomputer.  The  implementation  provides 
nucleus  level  constructs  and  file  options  from  the  ANSI 
COBOL  package  along  with  the  PERFORM  UNTIL  construct  from  a 
higher  level  to  give  increased  structural  control.  The 
language  was  implemented  through  a compiler  and  run-time 
package  executing  under  the  CP/M  operating  system  of  an  8080 
microcomputer-based  system.  Both  the  compiler  and 
interpreter  can  be  executed  in  20K  bytes  of  main  memory.  A 
program  consisting  of  8.5K  bytes  of  intermediate  code  can  be 
supported  on  this  size  machine.  Modification  of  the  compiler 
and  interpreter  programs  can  be  accomplished  to  take 
advantage  of  larger  machines.  The  programs  that  make  up  the 
compiler  and  interpreter  package  require  50K  bytes  of  disk 
storage. 
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I . INTRODUCTION 


A.  BACKGROUND 

The  NPS  MICRO-COBOL  Compiler/Interpreter  was  Initially 
(1976)  developed  to  demonstrate  that  It  was  feasible  to 
implement  a COBOL  compiler  on  a micro-computer.  It  was  known 
that  the  COBOL  language  used  would  have  to  be  a subset  of 
ANSI  COBOL  because  of  the  restriction  imposed  by  the  size  of 
a micro-computer  memory.  A subset  of  ANSI  COBOL, 
specifically  ADPSO  HYPO-COBOL,  was  selected  as  the  basis  for 
the  implementation  [3].  Additional  motivation  was  provided 
by  the  DOD  requirement  that  all  computers  used  in  a 
non-tactical  environment  be  capable  of  executing  COBOL. 

The  previous  work  was  directed  toward  five  major  areas: 
1.)  selecting  a suitable  COBOL  subset  to  operate  on,  2.) 
develop  the  associated  grammar  for  the  language,  3.) 
determine  what  type  of  compiler  to  design,  4.)  design  and 
code  the  compiler,  and  5.)  design  and  code  the  interpreter. 
The  interpreter  performs  the  functions  of  a classical 
linking  loader,  resolving  forward  address  references  and 
establishing  the  run  time  Intermediate  code  environment,  as 
well  as,  executing  the  lntermedite  code. 

The  establishment  of  a suitable  language  was  easily 
determined  since  HYPO-COBOL  was  a Department  of  the  Navy 
approved  subset  of  COBOL,  designed  to  place  minimal 
requirements  on  a system  for  compiler  support.  Where 
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possible,  short  constructs  were  used  in  the  place  of  longer 
ones.  Where  more  than  one  reserved  word  served  the  same 
function  in  COBOL  the  shortest  form  was  used.  There  is  no 
optional  verbage  in  the  language,  and  no  duplicate 
constructs  perform  the  same  function.  Limits  were  placed  on 
all  statements  that  had  a variable  input  format  so  that  all 
statements  had  a fixed  maximum  length.  Where  possible,  such 
constructs  were  removed  completely  from  the  language.  In 
addition,  user  defined  identifier  names  were  limited  to 
twelve  characters  to  reduce  symbol  table  storage 
requi rements . 

Rather  than  include  the  standard  levels  of 
implementation  for  all  of  the  modules,  constructs  were 
included  only  as  required.  In  addition  to  low  level 
constructs,  the  PERFORM  UNTIL  construct  was  included  to 
allow  better  program  structure.  Further  justification  for 
the  manner  of  subsetting  and  a highly  detailed  description 
of  each  element  of  the  language  is  contained  in  the 
HTPO-COBOL  language  specifications  reference  3.  For  a 
comparison  of  HTPO-COBOL  constructs  that  are  not  supported 
by  MICRO-CCBOL  see  appendix  5. 

The  grammar  for  the  MICRO-COBOL  language  was  defined  as 
LALR(l).  The  compiler  design  was  based  on  a table-driven 
parser  for  the  LALR(l)  grammar.  The  algorithm  used  to 
develope  the  parse  tables  for  the  compiler  was  developed  by 
7.  Lalonge  [17] . 

The  basic  design  and  coding  of  the  compiler  and 
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interpreter  was  completed  prior  to  the  current  thesis  wort 
by  Scott  Allan  Craig  [2].  Modification  to  the  original 
thesis  work  was  conducted  by  Phil  Mylet  [15]. 

B.  OPERATING  ENVIRONMENT 

The  NPS  MICRO-COBOL  compiler  and  interpreter  are 
designed  to  run  under  the  CP/M  operating  system  on  an  8080 
or  Z90  based  microcomputer  with  at  least  20K  bytes  of  main 
memory.  The  compiler  programs  are  designed  to  use  no  more 
than  12E  bytes  of  main  memory,  while  the  interpreter  program 
uses  approximately  8K  bytes.  The  compiler  and  interpreter 
require  50K  bytes  of  disk  storage  for  the  programs  that  make 
up  the  compiler/interpreter  package.  Eor  Information  on 
creating  MICRO-COBOL  source  programs  and  CP/M  see  references 
4 and  5. 

C.  GOALS  AND  OBJECTIVES 

The  primary  goal  of  this  thesis  project  was  to  complete 
the  implementation  of  an  8060  microcomputer  based 
compiler/interpreter,  which  could  compile  and  execute  a 
subset  of  the  ANSI  Standard  HTPO-COBOL  language 
specification.  To  achieve  this  goal  both  the  compiler  and 
interpreter  would  require  testing,  debugging,  modification 
and  implementation  (extension)  of  any  necessary  additional 
language  constructs.  It  was  also  decided  that  while  testing 
and  debugging,  the  documentation  of  the  compiler's  and 
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interpreter's  internal  structures,  memory  organization, 
interfaces  and  module  functions  would  be  accomplished. 

Since  the  amount  of  testing  and  debugging  effort  could 
not  be  accurately  determined,  several  subgoals  were 
established  which  would  be  undertaken  if  adequate  time  was 
available.  These  time  dependent  goals  included  the 
validation  of  the  compiler  and  interpreter  and  the  inclusion 
of  additional  language  constructs  not  previously 
implemented . 

In  addition  to  the  above  goals,  it  was  considered 
beneficial  to  update  and  incorporate  all  previous  thesis 
documentation  into  the  present  NPS  MICRO-COBOL  compiler  and 
interpreter  documentation.  This  documentation  is  appended  to 
this  thesis. 

D.  PRC3LEM  DEFINITION 

Tor  software  performance  assessment,  a series  of  simple 
COBOL  source  programs  and  the  Navy  Automated  Data  Processing 
Equipment  Selection  Office  EYP0-C030L  validation  test 
programs  (HCC7S)  were  compiled  and  execution  was  attempted. 
An  evaluation  of  the  test  results  Indicated  that  the 
compiler  and  interpreter  could  only  compile  and  execute  very 
simple  test  programs.  In  particular,  the  compiler  was  unable 
to  compile  past  the  file  section  of  the  first  validation 
proeram . 

A review  of  the  compiler  and  interpreter  documentation 
led  to  several  additional  conclusions.  The  compiler  and 
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interpreter  were  difficult  to  understand,  and  program  logic 
flow  was  hard  to  follow,  because:  1.)  modular  functions  were 
not  explained  well,  2.)  documentation  on  the  module 
interfacing  was  inadequate,  3.)  complete  specifications 
describing  the  Internal  structures  and  memory  organization 
did  not  exist,  and  4.)  few  comments  were  included  within  the 
source  code  listings. 
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II.  NPS  MICRO-COBOL  COMPILER 

A.  GENERAL  DESCRIPTION 

The  MICRO-COBOL  compiler  is  a one  pass  compiler  that 
scans  and  parses  MICRO-COBOL  source  programs,  and  generates 
intermediate  code  (pseudo-instructions)  for  the  interpreter 
(pseudo-machine).  The  scanner  design  is  similar  to  most 
other  scanner  implementations.  The  parser  is  an  LALR(l) 
table-driven  design,  implemented  in  the  PLM80  programming 
language  [8] . The  parse  tables,  as  stated  before,  were 
generated  using  an  algorithm  developed  at  the  University  of 
Toronto  [l?1  . 

The  compiler  reads  the  source  program  from  a disk  file, 
extracts  the  needed  information  for  the  symbol  table  and 
writes  the  pseudo-instructions  to  an  intermediate  code  file. 
To  accomplish  this  function,  the  compiler  consists  of  three 
modules:  PART  CNE,  IREADER , and  PART  TWO. 

B.  SYMBOL  TA3LE 

The  symbol  table  is  the  key  data  structure  in  the 
compiler.  Information  concerning  identifiers,  files,  and 
records  specified  in  the  DATA  DIVISION  of  the  MICRO-COBOL 
source  program  is  stored  in  the  symbol  table,  along  with 
labels  specified  in  the  PROCEDURE  DIVISION. 

The  symbol  table  structure  consists  of:  1.)  a sixty-four 
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address  hash  table,  2.)  a fixed  length  field  of  thirteen 
bytes  for  each  symbol  table  entry,  and  3.)  a variable  length 
field  to  hold  the  name  of  each  identifier.  Since  each 
Identifier  name  is  limited  to  twelve  ASCII  characters  the 
symbol  table  entry  for  Identifiers  can  vary  in  length  from 
thirteen  to  twenty-five  bytes.  The  bytes  of  each  symbol 
table  entry  are  grouped  into  various  fields  of  either  one  or 
two  bytes  depending  on  the  storage  requirements.  The 
thirteen  bytes  of  the  fixed  length  field  entry  are  numbered 
from  zero  to  twelve  and  the  variable  length  field  begins 
with  byte  thirteen.  In  referencing  a specific  field  a byte 
index  with  a value  from  zero  to  thirteen  is  utilized. 

The  symbol  table  entry  for  a single  identifier  could 
contain  up  to  nine  different  attributes  of  that  identifier, 
although  not  all  identifiers  required  the  full  range  of 
attributes.  The  various  fields  in  the  symbol  table  contained 
different  information  depending  on  whether,  for  example,  an 
identifier  was  a numeric  or  alphanumeric  type.  Four  of  the 
fields  contained  the  same  information  for  all  identifiers. 
These  fields  were:  1.)  field  zero  (bytes  zero  and  one  ) 
contained  the  collision  link,  2.)  field  one  (byte  two) 
contained  the  type  of  the  identifier,  3.)  field  two  (byte 
three)  contained  the  length  of  the  identifier  name,  and  4.) 
field  thirteen  (byte  thirteen)  was  the  beginning  of  the 
ASCII  character  representation.  It  should  be  noted  that  an 
identifier  of  type  FILLER  would  not  have  a name  associated 
with  it,  so  field  two  would  contain  a zero  and  field 
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thirteen  would  not  exist 


Entry  into  the  symbol  table  is  accomplished  by  using  a 
HASH  function  on  the  ASCII  character  representation  of  the 
identifier  name.  This  function  generates  an  even  number 
between  zero  and  126.  The  number  is  used  as  an  index  into 
the  hash  table  by  specifying  an  offset  from  the  base  of  the 
hash  table.  The  hash  table  can  hold  sixty-four  uniquely 
determined  address  references  to  identifiers.  The  hash  table 
entry  associated  with  each  index  reference  heads  a linked 
list  of  identifiers  with  the  same  HASH  function  value.  The 
linked  list  structure  provides  for  additional  identifier 
storage  and  therefore  the  number  of  uniaue  identifiers  is 
not  limited  by  the  sixty-four  index  values  generated  by  the 
HASH  function.  A zero  entry  in  the  hash  table  Indicates  that 
there  is  no  Identifier  with  that  HASH  function  value.  In 
tracing  through  the  linked  list  of  identifiers  the  most 
recently  declared  variable  appears  at  the  end  of  the  list. 
See  figure  fll-ll  for  an  example  of  the  computation  of  a 
hash  value.  See  figure  [11-2]  for  and  example  of  the  hash 
table  indexing  and  linking  of  hash  values. 
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HASH  VALUE  COMPUTATION 


HASH  Function  value:  sum  of  identifier  ASCII  characters 
logically  and  with  3FH  then  shifted  left  (SHL)  one  bit. 
HASHBASE  = 2000H 

P.F.(AB)  = HASHBASE  + SHL(((41H  + 42H ) AND  3FE),1)  = 2006H 
H.F.(BA)  = HASHBASE  + SHL(((42H  + 41H ) AND  3FH),1)  = 2006H 

FIGURE  II-l 


HASH  TABLE,  SYMBOL  TABLE  LINKING 
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1.  Numeric  Value? 

The  symbol  table  entry  for  numeric  values  can 
contain  up  to  seven  attributes  of  the  variable.  These 
attributes  are:  1.)  identifier  type,  2.)  length  of  variable 
name  3.)  beginning  address  of  variable  storage,  4.)  numeric 
count  (number  of  storage  locations  required  by  the 
identifier),  5.)  level  number,  6.)  number  of  digits  to  the 
right  of  the  decimal  point,  and  7.)  the  variable  name. 
Figures  [II-3]  and  [II-4]  illustrate,  respectively,  the 
following  two  COBOL  declarations: 

01  NUM  PIC  9(9). 

01  NUM  PIC  9(6). 999  OCCUP.S  12  TIMES. 

2 . Numeric  Edit 

The  numeric  edit  symbol  table  entry  eipands  on  the 
numeric  symbol  entry  and  utilizes  bytes  eight  and  nine  to 
hold  the  beginning  address,  in  the  constants  area,  of  the 
edit  field  mask.  This  mask  allowed  for  the  insertion  of  the 
following  characters  into  and  output  display  of  a numeric 

number:  fixed  and  floating  dollar  signs,  credlt(CR)  and 

I , . . 

debit(DB)  signs,  asterisk  fill,  Z character  fill,  and  plus 

("  + ")  and  minus  (”-'*)  signs.  It  should  be  noted  that  an 

identifier  with  a numeric  edit  field  value  can  not  be  used 

in  an  arithmetic  statement. 


NUMERIC  SYMBOL  TABLE  ENTRY 


BYTE 

SYMBOL  TABLE  VALUE 

0-1 

collision  link 

(00  00) 

2 

tyue  Identifier 
(10) 

length  of  Identifier 
name  (03) 


! beginning  address 
-5  j of  Identifier 

j storage  (04  25) 


6-7 

! length  of  Identifier 
i storage  (09  00) 

8-9 

! not  used 

10 

j level  entry  (01) 

11 

! decimal  count  (00) 

12 

! occurances  (00) 

13-15 

! Identifier  name 
! (4E  55  4D) 

01  NUM  PIC  9(9) . 
7IGURE  1 1-3 


NUMERIC  SYMBOL  TABLE  ENTRY  WITH  DECIMAL 
AND  OCCURS  CLAUSE 


0-1 


collision  link 
(09  2E ) 


type  identifier 
(10) 


length  of  identifier 
name  (03) 


beginning  address 
of  identifier  stor- 
age ( 0D  25) 


level  entry  (01) 


decimal  count  (03) 


length  of  identifier 
storage  (09  00) 


not  used 


01  MUM  PIC  9(6). 999  OCCURS  12  TIMES 
71  SURE  1 1 -4 


BYTE  SYMBOL  TABLE  VALUE 

i 


8-9 


occurances  (0C) 


identifier  name 
(4E  55  4D ) 


3.  Alpha  or  Alphanumeric 


The  alpha  and  alphanumeric  symbol  table  entries 
appear  similarly  in  the  symbol  table  except  for  their  type 
fields.  Six  entries  appear  in  the  symbol  table  for  these 
identifiers:  1.)  identifier  type,  2.)  length  of  identifier 
name,  3.)  beginning  address  of  storage,  4.)  number  of 
storage  locations  required  by  identifier,  5.)  level  entry, 
and  6.)  ldentifer  name.  Figure  C I I —51  illustrates  an  alpha 
symbol  table  entry  for  the  following  identifier  declaration: 

01  ALPHA  PIC  A (3). 

4.  Alpha  Id  it 

The  alpha  edit  symbol  table  entry  expands  on  the 
alpha  and  alphanumeric  edit  types  and  utilizes  bytes  eight 
and  nine  to  hold  the  beginning  address  of  the  edit  field 
mash.  These  mask  fields,  which  are  stored  in  the  constants 
area  of  the  pseudo-machine,  contain  the  characters  necessary 
to  edit  an  output  so  that,  for  example,  slashes  or  blanks 
can  be  interspersed  in  the  display  output. 


ALPHA  SYMBOL  TABLE  ENTRY 


f ! 

I 


BYTE  SYMBOL  TABLE  VALUE 


0-1  i 

collision  lint 

i 

i 

(00  00) 

2 i 

type  identifier 

i 

i 

(06) 

3 J length  of  Identifier 
! (05) 


! heginnin*  address 
4-5  | of  identifier 

! storage  (16  25) 


6-7 

{ length  of  identifier 
! storage  (08  00) 

8-9 

! not  used 

10 

! level  entry  (01) 

11 

! not  used 

12 

! not  used 

13-17 

! identifier  name 
! (41  4C  50  48  41) 

01  ALPHA  PIC  A (8  ) . 


FIGURE  1 1-5 
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5.  Tables 


NPS  MICRO-COBOL  was  designed  to  support  singly 
Indexed  tables.  These  tables  are  established  by  using  an 


OCCURS  clause 

with 

the  PICTURE 

clause 

of  an 

identifier. 

If 

an  identifier 

is 

specified 

as 

a 

table 

the  number 

of 

occurances  of 

the 

table  are  placed 

in 

byte 

twelve  of 

the 

symbol  table  entry  for  that  identifier.  The  table  identifier 
In  COBOL  is  similar  to  the  subscripted  variable  in  other 
programming  languages.  For  example,  the  statement,  "01  NUM 
PIC  9(9)  OCCURS  12  TIMES",  generates  the  symbol  table  entry 
illustrated  in  figure  [II-4]. 

6.  Labels 

Labels  generate  the  simplest  of  all  symbol  table 
entries,  only  four  or  five  attributes  are  associated  with 
the  label.  The  variability  depends  on  whether  the  label  is 
declared  in  the  source  program  before  or  after  the  label  is 
referenced  by  a CO  or  PERFORM  statement.  In  the  event  a 
label  is  specified  before  a GO  or  PERFORM  statement 
references  it,  the  symbol  table  would  contain  the  following 
1.)  the  type  associated  with  label,  2.)  the  length  of  the 
identifier  name,  3.)  the  address  of  the  first  intermediate 
code  instruction  following  the  appearance  of  the  label  in 
the  source  program  (bytes  four  and  five),  4.)  the  last 
executable  instruction  associated  with  the  label  (bytes 
eisht  and  nine)  This  would  be  either  the  last  executable 
instruction  encountered  before  another  label  or  the  end  of 
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the  program.,  and  5.)  the  label  name. 


In  the  event  a label  Is  referenced  by  a GO  or 
PERFORM  statement  before  the  label  actually  appears  In  the 
code,  the  symbol  table  entry  performs  a different  function 
than  Just  Indicating  the  beginning  and  ending  of  the 
paragraph  associated  with  the  label.  The  same  symbol  table 
fields  are  used,  however  their  meanings  are  different.  The 
type  is  set  to  the  unresolved  label  type  of  ( 0FFH ) . The 
label  remains  unresolved  until  the  beginning  and  the  ending 
addresses  of  the  associated  paragraph  are  determined. 

If  a label  is  referenced  for  the  first  time  by  a GC 
statement  the  symbol  table  Is  initialized  with  the 
following:  1.)  unresolved  label  type  ( 0FFH ) , 2.)  the  address 
of  the  GO  statement  (the  intermediate  code  would  be  5RN  30 
00  where  the  zeros  indicate  where  the  address  of  the  label 
is  to  be  backstuf fed)  . See  section  III  — D for  specific 
explanation  of  pseudo-machine  instructions.,  3.)  the 
remainder  of  the  label  entries  would  be  the  same  except  no 
entry  is  male  for  the  last  executable  instruction  associated 
with  the  label.  If  an  additional  reference  is  made  to  the 
label  by  a subsequent  GC  statement  the  following  action 
would  occur:  1.)  the  current  address  (bytes  four  and  five) 
would  be  placed  In  the  branch  address  of  the  GO  statement, 
2.)  the  address  of  this  branch  statement  would  be  placed  in 
bytes  four  and  five  of  the  symbol  table  entry.  This 
procedure  facilitates  linking  together  all  unresolved 
references  to  labels  so  that  when  the  label  are  resolved  the 
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correct  branch  address  could  be  placed  Into  the  intermediate 
code. 


! 


Encountering  a PERFORM  statement  before  a label  is 
declared  causes  the  following  actions:  l.)bytes  four  and 
five  contain  the  address  of  the  next  byte  of  intermediate 
code  following  the  PER  intermediate  code  instruction,  2.)and 
bytes  eight  and  nine  contain  the  address  of  the  third  byte 
following  the  PER  instruction.  If  a subsequent  PERFORM 
statement  is  encounted  before  the  label  is  resolved  the  two 
address  fields  in  the  symbol  table  would  be  copied  to  tne 
associated  bytes  following  the  most  current  PERFORM 
statement  and  the  address  of  the  first  and  third  bytes 
following  the  PER  instruction  would  be  copied  into  the 
symbol  table.  It  should  be  pointed  out  that  any  number  of 
PERFORM  and  GO  statements  can  be  specified  before  a label  is 
resolved . 


?.  Files 

The  symbol  table  entries  for  files  are  the  most 
difficult  to  understand.  The  complexity  of  the  entries  is 
due  to  the  way  files  and  records  are  declared  in  a 
MICRO-COBOL  program.  The  symbol  table  entry  for  a file 
consists  of  the  following:  1.)  byte  two  contains  the  type, 
2.)  byte  three  contains  the  length  of  the  file  name,  3.) 
bytes  four  and  five  contain  the  address  in  the  symbol  table 
of  the  first  01  level  record  associated  with  the  file,  4.) 
bytes  eight  and  nine  contain  the  beginning  address  of  the 
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file  control  block  and  input/output  buffer  for  the  file, 
(this  would  be  the  actual  address  in  the  data  section  of  the 
pseudo-machine  for  the  beginning  of  the  165  bytes  associated 
with  the  file' , 5.)  if  the  file  has  a key  entry  associated 
with  it  (acces  via  RANDOM  or  RANDOM  RELATIVE)  bytes  ten  and 
eleven  contain  the  symbol  table  address  of  the  access  key 
variable,  and  6.)  the  rest  of  the  entry  contains  the  file 
name.  Figure  [II-6]  illustrates  a file  entry  in  the  symbol 
table . 

8 . Records 

This  entry  contains  seven  attributes  of  a record. 
Three  are  the  same  as  all  other  entries  type,  name,  and 
length  of  name.  While  the  other  four  are:  1.)  bytes  four  and 
five  contain  the  initial  storage  address  for  the  record,  2.) 
bytes  six  and  seven  contain  the  number  of  bytes  of  storage 
for  the  record,  3.)  bytes  eight  and  nine  contain  the  symbol 
table  address  of  the  file  associated  with  the  record  (this 
facilitates  referencing  the  file  when  the  record  is 
written),  and  4.)  byte  ten  contains  the  level  entry  for  the 
record . 


FILE  SYMBOL  TABLE  ENTRY 

SAMPLE  SOURCE  PROGRAM  FILE  DECLARATION 

INPUT-OUTPUT  SECTION. 

FILE-CONTROL. 

SELECT  POSTER-FIL 

ORGANIZATION  RELATIVE 
ACCESS  PANDOM  RELATIVE  NUM 
ASSIGN  CS81-FIL. 


BYTE 

SYMBOL  TABLE  VALUE 

0-1 

! collison  link 
_ » 

2 

i 

! type  file 
! (03) 

3 

i length  of  file 
! name  (05) 

4-5 

! symbol  table 
! address  of  first 
! 01  level  record 
! (09  2E) 

6-7 

1 

! not  used 

8-9 

' first  address  of 
! FCB  & buffer 
! (0E  26) 

10-11 

! symbol  table 
! address  of  key 
(33  27) 

12 

! not  used 

13-17 

! file  name 
! (52  4F  53  54  45  52 
! 5F  46  49  4C ) 

FIGURE  1 1-6 


C.  COMPILER  MODULE  'PART  ONE" 


1 . Purpose 

This  first  module  of  the  compiler  performs  several 
functions.  First,  it  establishes  the  interface  between  the 
compiler  and:  1.)  the  input  source  file  (of  type  'CBL'),  2.) 
the  output  intermediate  code  file  (of  type  “CIN"),  and  3.) 
the  IREADSR  module  which  reads  and  passes  control  to  PART 
TWO  of  the  compiler.  Second,  it  scans  and  parses  the  source 
program  statements  up  to  the  PROCEDURE  DIVISION.  Third,  it 
generates  output  consisting  of  the  symbol  table  entries 
(saved  in  memory)  and  data  initialization  intermediate  code. 

2 . Control  Actions 

By  executing  the  command  COBOL  <source  program>,  the 
object  code  for  PART  ONE  of  the  compiler  is  loaded  into 
memory  starting  at  100H  (if  necessary  this  can  be  modified 
for  different  machines)  by  the  CP/M  operating  system. 
Execution  of  PART  ONE  loads  the  program  name  associated  with 
the  source  program  into  the  input  file  control  blocic  located 
at  5CH.  This  allows  the  source  program  name  to  be  saved 
until  actual  source  program  compilation  begins. 

Next,  the  control  program,  IREADER,  is  moved  to  high 
memory  Just  below  the  BDOS  (see  reference  4 for  an 
explanation  of  BDOS  and  other  CP/M  associated  names).  For 
example,  using  an  INTEL  Corporation  62S  MDS  microcomputer 
system  with  the  CP/M  operating  system,  the  IREADER  routine 
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is  moved  to  high  memory  starting  at  0C000H  and  continuing 
through  0D0FFH.  This  is  done  for  two  reasons:  1.)  it  allows 
the  symbol  table  of  the  source  program  to  begin  at  the  next 
address  following  the  object  code  for  PAST  ONE,  and  2.) 
places  IREADER  high  enough  in  memory  so  that  it  is  not 
• destroyed  by  creation  of  the  symbol  table.  See  figures 

[II-?]  and  [II-8]  for  illustrations  of  the  PART  ONE  memory 
organization  before  and  after  the  IREADER  routine  is  moved. 
The  purpose  of  the  IREADER  routine  will  be  explained  in  the 
next  section. 
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MEMORY  ORGANIZATION  BEFORE  I READER  ROUTINE  MOVSr 


BDOS 


Free  Area 


Ireader  Routine 
Before  Move 


Part  1 of  Compiler 


F000E 

Top  of  Memory 


D100H 


1003 


000H 


FIGURE  II-7 


Next , 

the  interface  between  the 

compiler  and 

the 

input 

file 

<source 

program>  and 

the  output 

file 

intermediate 

code  file> 

is  established 

. The  input 

file 

control 

block 

associated 

with  the  source 

file  is  initial 

ized 

and  the  Input  file  is  opened.  The  input  file  name  is  copied 
to  the  output  file  control  block  ( FCB ) and  if  there  is  ar 
intermediate  code  file  already  residing  on  the  disk,  it  is 
erased.  The  output  FCB  is  initialized  and  a file  directory 
entry  established  for  the  new  copy  of  the  intermediate  code 
file. 

Prior  to  beginning  the  scanning  and  parsing  actions, 
the  first  128  byte  record  of  the  input  file  is  read  into  the 
input  buffer,  located  at  80E  (default  I/C  buffer  for  CP/M). 
The  scanner  is  primed  with  the  first  character  of  the  input 
program,  and  scanning  and  parsing  actions  continue  from  this 
point  in  PART  CNF  until  the  PFOCEDURE  DIVISION  of  the  source 
program  is  encountered*  at  this  time  compilation  is 
suspended . 


! 

i 


' 

| 


Entries  made  in  the  symbol  table  by  PAPT  ONE  will 
consist  of  all  identifiers  declared  in  the  DATA  DIVISION  of 
the  source  program.  By  refering  to  the  Symbol  Table  Section 
above,  an  explanation  may  be  obtained  regarding  the  various 
types  of  symbol  table  entries. 


4. 


Intermediate  Code  Generation 


i 


I 


I • 


Pseudo-instructions  are  written  to  the  intermediate 
code  file  for  several  different  reasons  while  PART  ONE  is 
scanning  and  parsing  the  source  program.  The  first 
intermediate  code  generated  occurs  when  the  INPUT-OUTPUT 
SECTION  of  a source  program  is  nonempty.  Within  the  FILE 
CONTROL  PARAGRAPH  of  this  section,  instructions  are 
generated  to  initialize  the  FCP  for  the  file  name  associated 
with  the  SELECT  statement.  The  name  associated  with  the 
ASSIGN  statement  is  placed  in  the  FCB  and  is  used  in 
referencing  the  file  on  the  disk. 

Two  other  Instances  of  intermediate  code  generation 
occur  in  the  WORKING  STORAGE  SECTION  of  a source  program. 
Anytime  a record  or  elementary  identifier  entry  has  an 
edited  PICTURE  CLAUSE,  code  to  initialize  the  storage 
beginning  at  the  address  specified  in  the  formatted  mask 
attribute  of  the  symbol  table  entry  will  be  written  to  the 
intermediate  code  file.  When  a record  or  elementary 
Identifier  entry  has  an  associated  numeric  or  nonnumeric 
VALUE  CLAUSE,  code  to  initialize  the  storage  beginning  at 
the  address  specified  in  the  value  location  attribute  of  the 
symbol  table  entry  will  be  written  to  the  intermediate  cole 
file. 

The  final  pseudo-instruction  written  to  the 
intermediate  code  file  is  the  SCD  instruction.  This  occurs 
when  the  parser  parses  the  word  PROCEDURE  in  the  source 
program;  control  is  then  passed  to  PART  TWO  and  compilation 
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continues . 


5.  Parser  Actions 


The  actions  corresponding  to  each  parse  step  are 


explained  below.  In  each  case,  the  grammar  rule  that  is 


being  applied  is  given,  and  an  explanation  of  what  program 


actions  take  place  for  that  step  has  been  included.  In 


describing  the  actions  taken  for  each  parse  step  there  has 


been  no  attempt  to  describe  how  the  symbol  table  is 


constructed,  what  pseudo-instructions  are  generated  or  how 


the  values  are  preserved  on  the  stack.  The  intent  of  this 


section  is  to  describe  what  information  needs  to  be  retained 


and  at  what  point  in  the  parse  it  can  be  determined.  Where 


no  action  is  required  for  a given  statement,  or  where  the 


only  action  is  to  save  the  contents  of  the  top  cf  the  stack, 


no  explanation  is  given.  Questions  regarding  the  actual 


manipulation  of  information  should  be  resolved  by  consulting 


the  programs. 


1  <program>  : :=  <id-div>  <e-div>  <d-div>  PROCEDURE 


P.eading  the  word  PROCEDURE  terminates  the  first 


part  of  the  compiler. 


2  <ld-div>  IDENTIFICATION  DIVISION . PROGRAM-ID. 


<comment>  . <auth>  <date>  <sec> 


3  <auth>  AUTHOR  . <comment>  . 


<empty> 


5 <date>  DATE-WRITTEN  . <comment>  . 


<empty> 





. 


7 <sec>  ::=  SECURITY  . <comment>  . 

8 ! <empty> 

9 <comment>  : <lnput> 

10  ! <comment>  <laput> 

11  <e-dlv>  ENVIRONMENT  DIVISION  . CONFIGURATION 

SECTION  . 

<scr-obJ>  <l-o> 

12  <src-obJ>  SOURCE-COMPUTER  . <comment>  <debug>  . 

OBJECT-COMPUTER  . <comment>  . 

13  <debug>  DEBUGGING  MODE 

Set  a scanner  toggle  so  that  debug  lines  will  be 
read . 


14 

! <empty> 

15 

<l-o> 

INPUT-OUTPUT  SECTION  . FILE-CONTROL 

<f ile-control-list>  <ic> 

16 

! <empty> 

17 

<f 11 e- 

cont rol-11 st>  ::=  <f lle-control-entry> 

! <f lle-control-llst> 

<f lie-con trol-entry> 

19  <flle-control-entry>  SELECT  <id>  <attrlbute-llst> . 

At  this  point  all  of  the  information  about  the  file 
has  been  collected  and  the  type  of  th<*  file  can  be 
determined.  File  attributes  are  checked  for 
compatablllty  and  entered  In  the  symbol  table. 

20  <attribute-list>  <one  attrib> 

21  ! <attribute-llst>  <one  attrib> 

22  <one-attrlb>  : ORGANIZATION  <org-type> 
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Of- 


r: 


23 


I 

I 


ACCESS  <acc-type>  <relative> 
ASSIGN  <lnput> 


'■ 


I 
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A file  control  block  is  built  for  the  file  using  the 
INT  operator. 

25  <ore-type>  SEQUENTIAL 

No  information  needs  to  be  stored  since  the  default 
file  organization  is  sequential. 

26  | RELATIVE 

The  relative  attribute  is  saved  for  production  19. 

27  <acc-type>  SEQUENTIAL 

This  is  the  default. 

28  ! RANDOM 

The  random  access  mode  is  saved  for  production  19. 

29  <relative>  RELATIVE  <id> 

The  pointer  to  the  identifier  will  be  retained  by 
the  current  symbol  pointer,  so  this  production  only 
saves  a flag  on  the  value  stack  indicating  that  the 
production  did  occur. 

30  ! <empty> 

31  <ic>  I-O-CONTROL  . <same-llst> 

32  ! <empty> 

33  <same-list>  <same-element'> 

34  ! <same-*list>  <same-element> 

35  <same-element>  : SAME  <id-string>  . 

36  <id-string>  <id> 

37  ! <id-s tring>  <id> 

38  <d-dlv>  DATA  DIVISION  . <f ile-sect ion>  <work> 
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<link> 


39  <file-section>  FILE  SECTION  . <flle-llst> 

A flag  needs  to  be  set  to  Indicate  completion  of 
the  file  section,  so  that  the  appropriate  routine 
will  be  called  when  parsing  level  entries  in  the 
WORKING  STORAGE  SECTION. 

40  ! <empty> 

The  flag,  indicated  in  production  39,  is  set. 

41  <f lie-list > <f i le-elemen t> 

42  ! <file-llst>  <f ile-element> 

43  <files>  ::=  FD  <id>  <fi le-control>  . 

<record-des  cription> 

This  statement  indicates  the  end  of  a record 
description,  if  there  was  an  implied  redefinition 
of  the  record,  then  the  level  stack  (IDSSTACK) 
must  be  reduced.  The  length  of  the  first  record 
description  and  its  address  can  now  be  loaded 
into  the  symbol  table  for  the  file  name. 

44  <file-control>  : <flle-list> 

The  address  of  the  symbol  table  entry  for  the 
record  describing  the  file  name  is  entered  into  an 
attribute  of  the  file  name  symbol  table  entry, 
while  the  address  of  the  file  names  symbol  table 
entry  is  entered  into  an  attribute  of  the  same 
record . 

45  i <empty> 

Same  as  44  above. 
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46  < ?ile-list>  ::=  <f i le-elemen t> 


47  ! <file-llst>  <file-element> 

48  <file-element>  ::=  BLOCK  <integer>  RECORDS 

49  ! RECORD  <rec-count> 

The  record  length  Is  saved  for  comparison  with 
the  calculated  length  from  the  picture  clauses. 


50 

51 

52 

53 

54 


55 


56 

57 

58 

59 


I LABEL  RECORDS  STANDARD 
! LABEL  RECORDS  OMITTED 
! 7ALUE  OF  <id-string> 

<rec-count>  : :=  <integer> 

! <integer>  TO  <integer> 

The  TO  option  is  the  only  indication  that  the  file 
will  be  variable  length.  The  maximum  length  must  be 
saved  . 

<work>  ::=  WORKING-STORAGE  SECTION  . <record-description> 
If  the  level  stack  (ID4STACK)  contains  a record 
identifier  with  a level  number  greater  than  one, 
then  the  stack-  must  be  reduced.  The  reduction 
depends  on  whether  the  identifier  on  the  top  of 
the  stack  is  a redefinition  of  the  item  beneath 
it  or  not.  The  primary  action  is  to  assign  the 
proper  amount  of  storage  to  the  last  record  in 
the  WORKING  STORAGE  SECTION. 

! <empty> 

<llnk>  LINKAGE  SECTION  . <record-descrlption> 

! <empty> 

<record-description>  <level-entry> 
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60 


! <record-descriptionXlevel-entry,> 


61  <level-entry>  ::=  <integer>  <data-id>  <redeflnes> 

<data-type>  . 

The  symbol  table  address  for  the  level  entry 
Identifier  is  loaded  into  the  level  stack 
(ID$STACK).  The  level  stack  keeps  track  of  the 
nesting  of  field  definitions  (elementary  items) 
m a record  in  the  FILE  and  WORKING  STORAGE 
SECTIONS.  At  this  point  there  may  be  no  infor- 
mation about  the  length  of  the  item  being  defined 
and  its  attributes  may  depend  entirely  upon  its 
constituent  fields.  Within  the  FILE  SECTION, 
multiple  record  descriptions  for  a file  are 
assumed  to  be  redefinitions  of  the  first  record 
description.  In  the  WORKING  STORAGE  SECTION,  if 
there  is  a VALUE  CLAUSE,  the  stack  level  to  which 
it  applies  is  saved  in  PENDI NG$ LITERAL , the  level 
entry  number  is  saved  in  VALU2$LEVEL  and  a ?la«, 
VALUE$FLAG , is  set. 

62  <data-id>  ::=  <id> 

63  ! FILLER 

An  entry  is  built  in  the  symbol  table  to  record 
information  about  this  record  field.  It  cannot  be 
used  explicitly  in  a program  because  it  has  no  name, 
but  its  attributes  will  need  to  be  stored  as  part  of 
the  total  record. 

64  < redef ines>  : :=  REDEFINES  <id> 


m 


* 


S. 


The  redefines  option  gives  new  attributes  to  a 
previously  defined  record  area.  The  symbol  table 
pointer  to  the  area  being  redefined  is  saved  in  an 
attribute  of  the  redefining  identifier's  symbol  table 
entry,  so  that  information  can  be  transferred  to  the 
area  by  either  Identifier.  In  addition  to  the  inform- 
ation saved  relative  to  the  redefinition,  it  is  nec- 
essary to  check  to  see  if  the  current  identifier's 
level  number  is  less  than  or  eo.ual  to  the  level  number 
of  the  identifier  currently  on  the  top  of  the  level 
stack.  If  this  is  true,  then  all  information  for  the 
item  on  top  of  the  stack  has  been  saved  and  the  stack 
can  be  reduced.  If  the  current  identifier  is  a redef- 
inition of  another  identifier,  the  stack  entry  for  the 
record  being  redefined  is  not  removed  until  the  first 
non-redefinition  of  a current  identifier  at  the  same 
level . 

65  ! <empty> 

As  in  production  64,  the  stack  (ID^STACK)  is  checked 
to  determine  if  the  current  level  number  indicates  a 
reduction  of  the  level  stack  is  necessary.  In  add- 
ition, special  action  needs  to  be  taken  if  the  new 
level  is  01.  If  an  01  level  is  encountered  at  this 
production  prior  to  production  33  or  40  (the  end  of 
the  file  area),  it  is  an  implied  redefinition  of  the 
previous  01  level  record.  In  the  WORKING  STORAGE 
SECTION,  it  Indicates  the  start  of  a new  record. 
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66 

<data-type>  : : = 

<prop-list> 

67 

1 

1 

<empty> 

63 

<prop-list>  ::= 

<da  ta-elemen  t> 

69 

1 

I 

<prop-list>  <data-element> 

70 

<data-element> 

: :=  PIC  <input> 

The  <input>  at  this  point  is  the  character  string 
that  defines  record  field.  It  is  analyzed  and  the 
necessary  extracted  information  is  stored  in  the 
symbol  table. 

71  | USAGE  COMP 

The  field  is  defined  to  a binary  field;  however, 
COMP  has  not  been  implemented,  therefore,  if 
there  is  an  associated  VALUE  CLAUSE,  the  value  is 
entered  into  the  associated  identifier's  value 
storage  location  in  display  format. 

72  | DS ACE  DISPLAY 

The  DISPLAY  format  is  the  default,  and  thus  no 
special  action  occurs. 

73  ! SIGN  LEADING  <separate> 

This  production  indicates  the  presence  of  a sign  in 
a numeric  field.  The  sign  will  be  in  a leading 
position.  If  the  <separate>  indicator  is  true, 
then  the  length  will  be  one  longer  than  the  PICTURE 
CLAUSE,  and  the  type  will  be  changed  to  signed 
numeric  leading  and  separate. 

74  ! SIGN  TRAILING  <separate> 

The  same  information  required  by  production  73  must 
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be  recorded,  but  la  this  case  the  sign  is  trailing 
rather  than  leading. 

?5  ! OCCURS  <lnteger> 

The  type  must  be  set  to  Indicate  multiple 
occurrences  and  the  number  of  occurrences  saved 
for  comuuting  the  space  defined  by  this  field. 

?6  ! SYNC  <directlon> 

Syncronizat ion  with  a natural  boundary  is  not 
required  by  this  machine. 

7?  ! VALUE  <11 teral> 

The  field  being  defined  will  be  assigned  an  initial 
value  determined  by  the  value  of  the  literal  through 
the  use  of  an  1ST  operator.  This  is  only  valid  in 
the  WORKING-STORAGE  SECTION.  Note  that  numeric  and 
signed  numeric  PICTURE  CLAUSES  will  have  a numeric 

— no  quotes  delimiting  — VALUE  CLAUSE,  while 
alphanumeric  and  alpha  types  will  have  a nonnumeric 

— literal  delimited  with  quotes  — VALUE  CLAUSE. 

79  <direction>  LEFT 

79  | RIGHT 

90  ! <empty> 

81  <separate>  SEPARATE 

The  separate  sign  indicator  is  set. 

82  ! <empty> 

83  <literal>  : <input> 

The  input  string  is  checked  to  see  if  it  is  a valid 
numeric  literal,  and  if  valid,  it  is  stored 
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to  be 


used  in  a value  assignment. 


84  ! <lit> 

This  literal  is  a quoted  string. 

85  ! ZERO 

As  the  case  of  all  literals,  the  fact  that  there 
is  a pending  literal  needs  to  he  saved.  In  this 
case  and  the  three  following  cases,  an  indicator 
of  which  literal  constant  is  being  saved  is 
all  that  is  required.  The  literal  value  can  he 
reconstructed  later. 

96  ! SPACE 

37  ! QUOTE 

88  <inteeer>  <input> 

The  input  string  is  converted  to  an  integer  value 
for  later  internal  use. 

99  <id>  ::=  <input> 

The  input  string  is  the  name  of  an  identifier  and 
is  checked  aginst  the  symbol  table.  If  it  is  in  the 
symbol  table,  then  a pointer  to  the  entry  is  saved. 
If  it  is  not  in  the  symbol  table,  then  it  is 
entered  and  the  address  of  the  entry  is  saved. 


D.  INTERFACE  ACTIONS 

When  compilation  is  suspended  in  PART  ONE  of  the 
compiler  certain  key  variables  are  saved  for  use  in  PART 
TWO.  These  variables  are  declared  sequentially  in  PART  ONE 
and  are  therefore  located  in  contiguous  memory  in  the 


variable  area  of  PART  ONE.  These  variables  consist  of 


debugging  toggles  set  when  invoking  the  compiler  , i.e. 
sequence  or  token  numbers,  a pointer  to  the  next  available 
address  In  the  symbol  table,  a pointer  to  the  next  character 
in  the  input  source  file,  the  output  file  control  block,  the 
next  address  In  the  intermediate  code  area,  the  next  address 
in  the  constants  area,  and  the  base  address  of  the  symbol 
table.  These  key  variables,  consisting  of  48  bytes,  are 
copied  to  the  48  bytes  immediately  below  the  IREADER  routine 
to  insure  they  are  not  destroyed  when  PART  TWO  of  the 
compiler  is  brought  into  memory.  Since  the  memory  area 
required  for  PART  ONE  is  larger  than  that  required  by  PART 
TWO  the  symbol  table  does  not  need  to  be  relocated.  Since 
the  symbol  table  is  not  altered  when  PART  TWO  of  the 
compiler  is  brought  into  memory  only  the  base  address  of  the 
symbol  table  and  the  last  address  of  the  symbol  table  need 
be  saved  to  insure  that  access  to  the  symbol  table  can  be 
continued  in  PART  TWO.  See  Figure  [II-91  for  an  illustration 
of  the  memory  organization  when  control  is  transfered  from 
PART  ONE  to  IREADSE.  The  IP.EADE?  rountine  causes  PART  TWO  of 
the  compiler  to  be  brought  into  memory  starting  at  130H  and 
then  transfers  control  to  PART  TWO  of  the  Compiler. 


E . COMPILER  MCIULE  "PART  TWO" 

1 . Purpose 

The  second  part  of  the  compiler  scans  and  parses  the 


PROCEDURE 


MICR0-CC3CL  source  statements  starting  with  the 
DIVISION  and  generates  the  necessary  Intermediate  code. 


2.  Control  Actions 


The  first  action  after  cont 
TWO  from  the  IREADER  routine  Is  to 
information  saved  from  PART  ONE  lnt 
PART  TWO.  After  these  variables 
references  to  files,  symbol  table 
in  PART  TWO  and  compilation  can  con 
for  an  illustration  of  the  memory  o 
PART  TWO  begins  compilation. 


rol  Is  transfered  to  PART 
copy  the  48  bytes  of  the 
o associated  variables  in 
are  Initialized  all 
entries,  etc.  can  be  made 
tlnue.  See  Figure  [11-10] 
rganization  at  the  time 


3.  Symbol  Table  Entries 

Entries  made  In  the  symbol  table  by  PART  TWO  will  be 
those  for  paragraph  labels  encountered  within  the  PROCEDURE 
DIVISION  of  the  source  program. 

4 . Intermediate  Code  generation 

For  an  explanation  of  the  pseudo-instructions  that 
are  generated  by  PART  TWO  refer  to  the  compiler  program 
listings  and  the  parser  actions  below.  Also,  for  general 
Information  on  pseudo-instructions  refer  to  section  III-D. 
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MEMORY  ORGANIZATION  WHEN  CONTROL  IS  TRANSFEREE  TO  IREADER 
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MEMORY  ORGANIZATION  AFTER  PART  TWO  IS  COPIED  INTO  MEMORY 

Top  of  Memory 

0D100H 
0D000H 

0CFDF 

Top  of  Symbol 
Table  from 
PART  ONE 


100H 
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FIGURE  11-10 
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Variable  Area 


PART  TWO 
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Parser  Actions 


The  actions  corresponding  to  each  parse  step  in  PART 
TWO  are  explained  below.  In  each  case,  the  grammar  action 
that  is  being  applied  is  given,  and  an  explanation  of  what 
program  actions  take  place  for  that  step  has  been  included. 
In  describing  the  actions  taken  for  each  parse  step  there 
has  been  no  attempt  to  describe  how  the  symbol  table  entries 
are  made,  what  pseudo  instructions  are  generated  or  how  the 
values  are  preserved  on  the  stack.  The  intent  of  this 
section  is  to  describe  what  information  needs  to  be  retained 
and  at  what  point  in  the  parse  it  can  be  determined.  Where 
no  action  is  required  for  a given  statement,  or  where  the 
only  action  is  to  save  the  contents  of  the  top  of  the  stack, 
no  explanation  is  given. 

1 <p-div>  PROCEDURE  DIVISION  <uslng>  . 

<proc-body>  EOF 

This  production  indicates  termination  of  the 
compilation.  If  the  program  has  sections,  then 
it  will  be  necessary  to  terminate  the  last  section 
with  a RET  0 instruction.  The  code  will  be  ended 
by  the  output  of  a TER  operation. 

2 <using>  USING  <id-string> 

Not  implemented. 

3 i <empty> 

4 <id-string>  <id> 

The  identifier  stack  is  cleared  and  the  symbol 
table  address  of  the  identifier  is  loaded  into 


4? 


the  first  stack  location. 

5 ! <id-string>  <id> 

The  identifier  stack  is  incremented  and  the  symbol 
table  pointer  stacked. 

6 <proc-body>  <paragraph> 

7 ! <prcc-body>  <paragraph> 

8 <paragraph>  <id>  . <sentence-llst> 

The  starting  and  ending  address  of  the  paragraph 
are  entered  into  the  symbol  table.  A return  is 
emitted  as  the  last  instruction  in  the  paragraph 
(RET  0).  When  the  label  is  resolved,  it  may  be 
necessary  to  produce  a BST  operation  to  resolve 
previous  references  to  the  label. 

9 I <id>  SECTION  . 

The  starting  address  for  the  section  is  saved.  If 
it  is  not  the  first,  then  the  previous 
section  ending  address  is  loaded  and  a return 
(RET  0)  is  output.  As  in  production  6,  a BST  may 
be  produced. 

10  <sentence-list>  <sentence>. 

11  ! <sentence-llst>  <sentence>  . 

12  <sentence>  : :=  <imperatlve> 

13  ! <conditional> 

14  ! ENTER  <id>  <opt-id> 

This  construct  is  not  Implemented.  An  ENTER  allows 
statements  from  another  language  to  inserted  in  the 
source  code. 


15  <l:nperative>  ::=  ACCEPT  <subid> 
ACC  <address>  <length> 


r 


I 


r 

i 

' 

; 
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16  i <arithmetic> 

17  | CALL  <lit>  <using> 

This  is  not  implemented. 

18  ! CLOSE  <id> 

CLS  <file  control  block  address> 

19  ! <flle-act> 

20  i DISPLAY  <li t/id>  <opt-lit/id> 

The  display  operator  is  produced  for  the  first 
literal  or  Identifier  (DIS  <address>  <length>  <flag>). 
If  the  second  value  exists,  the  same  code  Is  also 
produced  for  It.  The  only  difference  in  the  two 
display  outputs  is  the  flag  Is  set  to  zero  on  the 
first  display  to  surpress  the  carriage  return  and 
line  feed. 

• 

21  ! EXIT  <program-id> 

RET  0 

22  ! GO  <id> 

BRN  <address> 

23  ! GO  <id-string>  DEPENDING  <id> 

GDP  is  output,  followed  by  a number  of  parameters: 

<the  number  of  entries  in  the  identifier  stack> 

<the  length  of  the  depending  identified  <the 
address  of  the  depending  Identified  <the  address 
of  each  identifier  in  the  stack>. 
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MOVE  <lit/id>  TO  <subid> 


The  types  of  the  two  fields  determine  the  move  that 
is  generated.  Numeric  moves  go  through  register  two 
using  a load  and  a store.  Non-numeric  moves  depend 
upon  the  result  field  and  may  he  either  MOV,  MED  or 
MNE.  Since  all  of  these  instructions  have  long 
parameter  lists,  they  have  not  been  listed  in 
detail. 


25  J OPEN  <type-action>  <id> 

This  produces  either  OPN,  0P1 , or  0P2  depending 
upon  the  <type-acti on> . Each  of  these  is  followed 
by  file  control  block  address. 

26  I PERFORM  <id>  <thru>  <finish> 

The  PER  operation  is  generated  followed  by  the 
<branch  address>  <the  address  of  the  return 
statement  to  be  set>  and  <the  next  instruction 
address> . 

27  ! <read-id> 


29  | STOP  <terminate> 

! If  there  is  a terminate  message,  then  STD  is 

produced  followed  by  <message  address>  <message 
length>.  Otherwise  STP  is  emitted. 

29  <conditlonal>  ::=  <arithmetic>  <size-error>  <imperative> 

A 3ST  operator  is  output  to  complete  the  branch  around 
the  imperative  from  production  65. 

30  ! <file-act>  <invalid>  <imperative> 

A BST  operator  is  output  to  complete  the  branch  from 


production  64 


31  ! < if-nonterminal>  <condition>  <action> 

ELSE  <imperati ve> 

NEG  will  be  emmitted  unless  <conditlon>  is  a 
‘NOT  <cond-type> " , in  which  case  the  two  negatives 
will  cancel  each  other.  Two  3ST  operators  are  required. 
The  first  fills  in  the  branch  to  the  ELSE  action.  The 
second  completes  the  branch  around  the  <imperative> 
which  follows  ELSE. 

32  ! <read-id>  <special>  <imperative> 

A 3ST  is  produced  to  complete  the  branch  around  the 
<imperat ive> . 

33  <Ari thmet i c>  ADD  <l/id>  <opt-l/ld>  TO  <subid> 

< round  > 

The  existence  of  multiple  load  and  store  instructions 
ma<ce  it  difficult  to  Indicate  exactly  what  code  will 
be  generated  for  any  of  the  arithmetic  instructions. 
The  type  of  load  and  store  will  depend  on'the  nature 
of  the  number  involved,  and  in  each  case  the  standard 
parameters  will  be  produced.  This  parse  step  will  in- 
volve the  following  actions:  first,  a load  will  be  em- 
itted for  the  first  number  into  regster  zero.  If 
there  is  a second  number,  then  a load  into  register 
one  will  be  produced  for  it,  followed  by  an  ADD  and  a 
STI.  Next  a load  into  register  one  will  be  generated 
for  the  result  number.  Then  an  ADD  instruction  will 
be  emitted.  Finally,  if  the  round  indicator  is  set,  a 
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P.ND  operator  will  be  produced  prior  to  the  store. 

34  ! DIVIDE  <l/id>  INTO  <subid>  <round> 

The  first  number  is  loaded  into  register  zero.  The 
second  operand  is  loaded  into  register  one.  A DIV 
operator  is  generated,  followed  by  a RND  operator  prior 
to  the  store,  if  required. 

35  ! MULTIPLY  <l/id>  BY  <subid>  <round> 

The  multiply  is  the  same  as  the  divide  except  that  a 
MUL  operator  is  generated. 

36  | SUBTRACT  <l/id>  <opt-l/id>  FROM 

<subid>  <round> 

Subtaction  generates  the  same  code  as  the  ADD  except 
that  a SUB  is  produced  in  place  of  the  last  ADD. 

37  <file-act>  ::=  DELETE  <id> 

Either  a DLS  or  a DLR  will  be  produced  along  with  the 
required  parameters. 

38  ! REWRITE  <id> 

Either  a F.WS  or  a RWR  is  emitted,  followed  by  parame- 
ters. 

39  ! WRITE  <id>  <special-act> 

There  are  four  possible  write  instructions:  WTF,  WV1, 
WRS , and  WRR . 

4i3  <condition>  ::=  <lit>  <not>  <cond-type> 

One  of  the  compare  instructions  is  produced.  They  are 
CAL,  CNS , CNU,  RGT , RLT , REQ,  SGT,  SLT , and  SSQ. 

Two  load  instructions  and  a SUB  will  also  be  generated 


if  one  of  the  register  comparisons  is  reauired. 


NUMERIC 


' ! 

t 
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42 

43 

44 


45 


<cond-type> 


! ALPHABETIC 


i <compare>  <lit/id> 

<not>  NOT 

NEC  Is  emitted  unless  the  NOT  is  part  of  an  I? 
statement  in  which  case  the  NES  in  the  I? 
statement  is  cancelled. 

! <empty> 


46 

<compare> 

::=  GREATER 

4? 

I LESS 

48 

! EQUAL 

49 

<R0UND>  :: 

= ROUNDED 

50  i <empty> 

51  <terninates  ::=  <literal> 

52  ! RUN 

53  <special>  <invalid> 

54  ! END 

An  ERO  operator  is  emitted  followed  by  a zero.  The 
zero  acts  as  a filler  in  the  code  and  will  he  bacn- 
stuffed  with  a branch  address.  In  this  production 
and  several  of  the  following,  there  is  a forward 
branch  on  a false  condition  past  an  imperative  action. 
For  an  example  of  the  resolution,  examine  production  32. 


55 

<opt-id> 

: :=  <subid> 

56 

! <empty> 

57 

<act ion> 

: :=  < imperat  ive> 

BRN  0 


1 


53 




1 53 

! NEXT  S ENTENCI 

BRN  0 

59 

<thru>  ::=  THRU  <id> 

ee 

! <empty> 

61 

<fimsh>  : :=  <l/ld>  TIMES 

LDI  <address>  <length>  DEC  0 

| 62 

M 

! UNTIL  <condition> 

63 

N 

64 

! <empty> 

<invalid>  ::=  INVALID 

i I 

INV  0 

65 

<size-error>  ::=  SIZE  ERROR 

SIR  0 

[1  66 

< special-act>  ::=  <vhen>  ADVANCING 

<how-many,' 

67 

! <empty> 

63 

<vhen>  = BEFORE 

69 

! AFTER 

72 

<hov-many> : :=  <int?ger> 

71 

! RAGE 

- 

! 1-0 

\ 75 

76 

<subidN  ::=  <sub script^ 

! <id> 

77 

<integer>  ::=  <lnput> 

The  value  of  the  Input  string  is 

saved  as  an  inter 

nal 

number . 

73 

<ii>  : : = <irput> 

The  identifier  is  checked  aginst 

the  symbol  table. 

if 

it  is  net  present,  it  is  entered 

as  an  unresolved 

1 1 

El  i 

54 

- 1 

la  bel . 

79  <l/id>  : :=  <input> 

The  input  value  may  be  a numeric  literal.  If  so,  it 
is  placed  in  the  constant  area  with  an  INT  operand. 
If  it  is  not  a numeric  literal,  then  it  must  be  an 
identifier,  and  it  is  located  in  the  symbol  table. 

60  ! <subscript> 

81  ! ZERO 

32  <subscript>  : :=  <id>  ( <input>  ) 

If  the  identifier  was  defined  with  a USING  option, 
then  the  input  string  is  checked  to  see  if  it  is  a 
number  or  an  identifier.  If  it  is  an  identifier, 
then  an  SCfi  operator  is  produced. 

33  <opt-l/id>  : :=  <l/ld> 

84  ! <empty'> 

65  <nn-lit>  : :=  <lit> 

The  literal  string  is  placed  into  the  constant  area 
usine  an  INT  operator. 

96  ! SPACE 

37  | QUOTE 

96  <literal>  ::=  <an-lit> 

89  !< input > 

The  input  value  must  be  a numeric  literal  to  be  valid 
and  is  leaded  into  the  constant  area  usin*  an  INT. 


90  ! ZEPO 

91  <'llt/ii>  <l/id> 

92  ! <nn-lit> 
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93  <opt-lit/ii>  <lit/id> 


94 

! <empty> 

95 

<program-id> 

<id> 

96 

! <empty> 

97 

<read-ld> 

READ  <id> 

There  are  four  read  operations:  RDF , SVL,  RRS , and 
RRP. 


Ill  . NPS  MICRO-COBOL  INTER??. 5TER 


A.  GENERAL  DESCRIPTION 

The  following  sections  describe  the  NPS  MICRO-COBOL 
pseudo-machine  in  terms  of  the  implementation,  memory 
organization,  interface  actions  and  interpreter 
instructions.  The  pseudo-machine,  which  is  constructed  in 
the  transient  program  area  of  CP/M,  is  the  target  machine 
for  the  compiler  and  is  implemented  through  a programmed 
interpreter.  The  interpreter  decodes  each  operation  and 
either  calls  subroutines  to  perform  the  required  actions  or 
acts  iir°ctly  on  the  run  time  environment  to  control  the 
actions  of  the  interpreter.  All  communicatior.s  between 
instructions  is  done  through  common  areas  in  the  program 
where  information  can  be  stored  for  later  use.  See  figure 
[III-n  for  an  illustration  of  the  pseudo-machine 
organization. 

The  machine  contains  a program  counter  and  multiple 
parameter  operations  which  contain  all  the  information 
required  to  perform  one  complete  action  required  by  the 
language.  Three  eighteen  digit  registers  are  used  for 
arithmetic  operations,  along  with  a subscript  stack  used  to 
compute  subscript  locations,  and  a set  of  flags  are  used  to 
pass  branching  information  from  one  instruction  to  another. 


Addresses  in  the  pseudo-machine  are  represented  by  16 
bit  values.  Ar.y  memory  address  greater  than  20  hexldecimal 


Is  valid.  Addresses  less  than  22  hexidecinal  will  be 
interpreted  as  having  special  significance.  For  example 
addresses  one  through  eight  are  reserved  for  subscript  stack 
references.  All  other  addresses  in  the  machine  are  absolute 
addresses . 

The  registers  allow  manipulation  of  signed  numbers  up  to 
eighteen  digits  in  length.  Included  in  their  representation 
is  a sign  indicator  and  the  position  of  the  assumed  decimal 


point 

for 

the  current 

ly  loaded  number.  Numbers 

are 

re  presen 

ted 

in  standard 

COEOL 

"Display"  format. 

These 

numbers 

may 

have  separate 

signs 

indicated  by  "♦"  and 

or 

may  have  a "zone''  indicator,  denoting  a negative  sign,  in 
the  most  significant  byte  of  a number's  storage  location. 
Before  operations  occur  on  any  number,  it  is  converted  to  a 
packed  decimal  format  and  entered  into  one  of  the 
pseudo-machine  registers. 

B.  PSPORT  03d  AN IZATICN 

The  memory  of  the  pseudo-machine  is  divided  into  three 
ma„ior  areas:  1.)  the  data  area  is  established  by  the  DATA 
DIVISION  statements  of  the  source  program,  2.)  the  constants 
area  which  is  established  by  both  the  DATA  and  PROCEDDHF 
DIVISIONS  of  the  source  program,  and  3.)  the  code  area  which 
is  established  by  the  PROCEDURE  DIVISION. 

The  data  area  is  the  lowest  area  in  the  pseudo-machine. 
This  area  contains  the  storage  for  identifiers  declared  in 
the  DATA  DIVISION.  Additionally,  the  data  area  contains  the 


58 


File  Control  Block  (FC3)  and  the  buffer  space  (128  bytes) 
for  all  files  declared  in  the  source  program. 

Immediately  following  the  data  area  is  the  code  area. 
This  contiguous  area  of  storage  contains  all  executable  code 
generated.  The  constants  area  is  located  in  high  memory  of 
the  pseudo-machine.  This  area  contains  all  edit  field  masks 
as  well  as  all  numeric  and  non-numeric  literals.  Figure 
[III —1 1 ilustrates  the  memory  organization  of  the 
pseudo-machine . 
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C.  INTERPRETER  INTERFACE 
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The  interpreter  consists  of  two  interface  routines  and 
the  main  interpreter  program.  To  execute  the  interpreter  the 
command  EXEC  <f ilename.f iletypeb,  (where  file  type  is  CIS), 
is  typed  at  the  terminal.  This  action  causes  the  two 
interface  routines,  BUILD  and  INTP.DR,  to  be  brought  into 
memory.  See  figure  [II 1—2]  which  illustrates  the  memory 
organization  immediately  after  BUILD  and  INTRDR  have  been 
copied  into  memory.  The  BUILD  routine  reads  in  the 
intermediate  code,  initializes  all  memory  locations 
requiring  initalization , and  resolves  all  unresolved  address 
references.  The  INTRDR  routine  reads  the  interpreter  program 
into  memory  and  transfers  control  to  the  interpreter 
program. 

The  intermediate  code  instructions  fall  into  two 
categories:  1.)  instructions  used  by  3UILD  to  establish  the 
run  time  environment  and,  2.)  instructions  to  be  executed  by 
the  interpreter.  The  following  four  instructions  are 
venerated  in  the  compiler  for  use  by  the  BUILD  routine,'  SCD, 
INT,  BST , and  TER. 

The  SCD  (start  code)  instruction  is  the  last  instruction 
generated  by  PART  ONE  and  indicates  where  the  first 
executable  instruction  for  the  intermediate  code  is  to  be 


loaded . 

This 

corresponds 

to 

the  address  immediately 

following  the 

data  area 

in  th 

e pseudo-machine.  See  Figure 

[III-l] 

which 

illustrates 

the 

relative  location  of  the 

address 

that  is 

associated 

wi  th 

the  SCD  instruction. 
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MEMORY  ORGANIZATION  AFTER  3UILD  AND  INTRDR 
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The  INT  (initialize)  instruction  causes  the  BUILD 


routine  to  initialize  the  data  area  with  the  values 
associated  with  those  identifiers  in  the  DATA  DIVISION  of 
the  source  program  that  had  VALUE  CLAUSES.  In  addition,  the 
INT  instruction  causes  the  BUILD  routine  to  initialize  the 
constants  area  with  all  the  edit  masks  for  those  identifiers 
of  the  numeric  and  alphanumeric  edit  type,  and  all  literals 
er.cour.ted  in  the  PROCEDURE  DIVISION  of  the  source  program. 

The  BST  (backstuff)  instruction  resolves  all  unresolved 
references,  i.e.  branches  to  labels  defined  after  the 
respective  PERFORM  or  50  statement  was  encountered  in  the 
source  program. 

The  TER  (terminate)  instruction  is  the  last  instruction 
generated  by  PART  TWO  of  the  compiler  and  indicates  the  end 
of  the  intermediate  code  file.  Upon  encountering  a TER 


instruction  in  the  intermediate  code  the  BUILD  routine 
inserts  a ST?  instruction  in  its  place.  The  ST?  instruction 
will  cause  the  interpreter  to  terminate  interpretation  of 


the  program  when  encountered. 


All  other  code  generated  by  the  compiler  is  copied  into 
the  code  area  of  the  pseudo-machine  by  the  BUILD  routine. 
See  Figure  [III-31  for  an  illustration  of  the  memory 
organization  at  this  point  in  the  initialization  routine. 
The  final  action  taken  by  the  BUILD  routine  is  to  move  the 
INTPDR  routine  into  the  input  buffer  at  80H  and  transfer 
control  to  INTRDR.  This  frees  the  area  from  100H  to  the  base 
of  the  data  area  for  the  interpreter. 


I 


The  INTRDR  routine 

reads  the 

interpreter 

program 

into 

memory  starting 

at 

100H  and  transfers  contol  to  it. 

From 

this  point  on 

the 

interpreter 

program 

executes 

the 

intermediate  code  that  was  loaded  into  the  pseudo-machine. 


MEMORY  ORGANIZATION  AFTER  INTERMEDIATE  CODE  IS 


D.  PSEUDO-MACHINE  INSTRUCTIONS 
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This  section  briefly  covers  the  pseudo-machine 
instructions  used  in  the  interpreter,  their  format,  and  the 
actions  which  they  accomplish. 

1 . Format 

All  of  the  interpreter  instructions  consist  of  an 
instruction  number  followed  by  a list  of  parameters.  The 
following  sections  describe  the  instructions,  list  the  re- 
quired parameters,  and  describe  the  actions  taken  by  the 
machine  in  executing  each  instruction.  In  each  case,  parame- 
ters are  denoted  informally  by  the  parameter  name  enclosed 
in  brackets.  The  BRN  branching  instruction,  for  example, 
uses  the  single  parameter  <'oranch  address^  which  is  the  tar- 
get of  the  unconditional  branch. 

As  each  instruction  number  is  fetched  from  memory, 
the  program  counter  is  incremented  by  one.  The  program 
counter  is  then  either  incremented  to  the  next  instruction 
number,  or  a branch  is  taken. 

The  three  eighteen  digit  registers  which  are  used  by 
the  instructions  covered  in  the  following  sections  are  re- 
ferred to  as  registers  zero,  one,  and  two. 

2 . Arithmetic  Operations 

There  are  five  arithmetic  instructions  which  act 
upon  the  three  registers.  In  all  cases,  the  result  is 
placed  in  register  two.  Operations  are  allowed  to  destroy 
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the  input  values  during  the  process  of  creating  a result, 
therefore,  a number  loaded  into  a register  is  not  available 


for  a subsequent  operation. 

ADD:  (addition).  Sum  the  contents  of  register  zero 
and  register  one. 

Parameters:  no  parameters  are  required. 

SUB:  (subtract).  Subtract  register  zero  from  register 

one . 

Parameters:  no  parameters  are  required. 

MUL:  (multiply).  Multiply  register  zero  by  register 

one . 

Parameters:  no  parameters  are  required. 

DIV:  (divide).  Divide  register  one  by  the  value  in 
register  zero.  The  remainder  is  not  retained. 

Parameters:  no  parameters  are  recuired 

RND:(rcund).  Round  register  two  to  the  last  signifi- 
cant decimal  place. 

Parameters:  nc  parameters  are  required. 

3 . Branching 

The  machine  contains  the  following  flags  which  are 
used  by  the  conditional  instructions  in  this  section. 

BRANCH  flag  — indicates  if  a branch  is  to  be  taken? 
END  OP  RECORD  flag  — indicates  that  an  end  of 
input  condition  has  been  reached  when  an  attempt  was  made 
to  read  input? 

OVERFLOW  flag  — indicates  the  loss  of  information 


I 

i 

i • 


67 


from  a register  due  to  a number  exceeding  the  available 
size; 


| 


INVALID  flag  — indicates  an  invalid  action  in 
writing  to  a direct  access  storage  device. 

$11  of  the  branch  instructions  are  executed  by 
changing  the  value  of  the  program  counter.  Some  are  uncon- 
ditional branches  and  some  test  for  condition  flags  which 
are  set  by  other  instructions.  A conditional  branch  is  exe- 
cuted by  testing  the  branch  flag  which  is  initialized  to 
false.  A true  value  causes  a branch  by  changing  the  pro- 
gram counter  to  the  value  of  the  branch  address.  The  branch 
flag  is  then  reset  to  false.  A false  value  causes  the  pro- 
gram counter  to  be  Incremented  to  the  next  sequential  in- 
struction . 

3RN : (branch  to  an  address).  Load  the  program 

counter  with  the  Cbranch  address>. 

Parameters:  <branch  address> 

The  next  three  instructions  share  a common  format. 
The  memory  field  addressed  by  the  <memory  address>  is 
checked  for  the  <address  length>,  and  if  all  the  characters 
match  the  test  condition,  the  branch  flag  is  complemented 
Parameters:  <memory  address>  <address  length>  <branch  ad- 
dress> 

CAL:  (compare  alphabetic).  Compare  a memory  field 

for  alphabetic  characters. 

CNS : (compare  numeric  signed).  Compare  a field  for 

numeric  characters  allowing  for  a sign  character. 
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GNU:  (compare  numeric  unsigned).  Compare  a field  for 
numeric  characters  only. 

DEC:  (decrement  a counter  and  branch  If  zero), 
decrement  the  value  of  the  <address  counter>  by  one;  if  the 
result  Is  zero  before  or  after  the  decrement,  the  program 
counter  Is  set  to  the  <branch  address>.  If  the  result  is 
not  zero,  the  program  counter  Is  incremented  by  four. 
Parameters:  <address  counter>  <branch  address> 

EOR : (branch  on  end  of  records  flag).  If  the  end- 

of-records  flag  is  true,  it  is  set  to  false  and  the  program 
counter  is  set  to  the  <branch  address>.  If  false,  the  pro- 
gram counter  is  Incremented  by  two. 

Parameters:  ^branch  address> 

GDP:  (go  to  - depending  on).  The  memory  location  ad- 
dressed by  the  <number  address>  Is  read  for  the  number  of 
bytes  indicated  by  the  <memory  length/.  This  number  indi- 
cates which  of  the  <branch  addresses)*  Is  to  be  used.  The 
first  parameter  is  a bound  on  the  number  of  branch  ad- 
dresses. If  the  number  is  within  the  ran«e,  the  program 
counter  is  set  to  the  indicated  address.  An  cut-of-bounds 
value  causes  the  program  counter  to  be  advanced  to  the  next 
sequential  instruction. 

Parameters:  <bour.d  number  - byte>  <memory  length>  <memory 
address)  <branch  addr-l>  <branch  addr-2>  ...  <branch  addr-n> 
INV:  (branch  if  invalid-file-action  flag  true).  If 
the  invalid-file-action  flag  is  true,  then  it  is  set  to 
false,  and  the  program  counter  is  set  to  the  branch  ad- 
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dress.  If  It  is  false,  the  program  counter  is  incremented 
by  two. 

Parameters:  <branch  address> 

PER:  (perform).  The  code  address  addressed  by  the 
<change  address>  is  loaded  with  the  value  of  the  <return  ad- 

\ 

dress>.  The  program  counter  is  then  set  to  the  <branch  ad- 
dress> . 

Parameters:  <branch  address>  <change  address>  <return  ad- 
dress) 

RET:  (return).  If  the  value  of  the  <branch  address> 
is  not  zero,  then  the  program  counter  is  set  to  its  value, 
and  the  <branch  address>  is  set  to  zero.  If  the  <branch  ad- 
dress) is  zero,  the  program  counter  is  incremented  by  two. 

Parameters:  <tranch  address) 

REQ:  (register  equal).  This  instruction  checks  for  a 
zero  value  in  register  two.  If  it  is  zero,  the  branch  flag 
is  complemented.  A conditional  branch  is  taken. 

Parameters:  <branch  address) 

RGT:  (register  greater  than).  Register  two  is 
cheesed  for  a negative  sign.  If  present,  the  branch  flag  is 
complemented.  A conditional  branch  is  taken. 

Parameters:  <tranch  address) 

RLT:  (register  less  than).  Register  two  is  checked 
for  a positive  sign,  and  if  present,  the  branch  flag  is  com- 
plemented. A conditional  branch  is  taken. 

Parameters:  <branch  address) 

SER:  (branch  on  size  error).  If  the  overflow  flag  is 
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true,  then  the  program  counter  Is  set  to  the  branch  address, 
and  the  overflow  flag  Is  set  to  false.  If  it  is  false,  then 
the  program  counter  is  incremented  by  two. 

Parameters:  <branch  address> 

The  next  three  instructions  are  of  similar  form  in 
that  they  compare  two  strings  and  set  the  branch  flag  if 
the  condition  is  true. 

Parameters:  <string  addr-l>  <string  addr-2>  <length  - ad- 
dress>  <branch  address> 

S5Q:  (strings  equal).  The  condition  is  true  if  the 
strings  are  equal. 

SGT:  (string  greater  than).  The  condition  is  true  if 
string  one  is  greater  than  string  two. 

SLT:  (string  less  than).  The  condition  is  true  if 
string  one  is  less  than  string  two. 

4 . f*oves 


The  machine  supports  a variety  of  move  operations 
for  various  formats  and  types  of  data.  It  does  not  suoport 
direct  moves  of  numeric  data  from  one  memory  field  to  anoth- 
er Instead,  all  of  the  numeric  moves  go  through  the  regis- 
ters. 
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n instructions  all  perform  the  same 
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of  number  that  they  expect  to  see  in 
r address>.  All  seven  instructions 
er  to  be  Incremented  by  five.  Their 
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common  format  is  given  below. 

Parameters:  Cnumber  address>  <byte  length)  <byte  decimal 
count)  <byte  register  to  load> 


LCD:  (load  literal).  Register  two  is  loaded  with  a 
constant  value.  The  decimal  point  indicator  is  not  set  in 
this  instruction.  The  literal  will  have  an  actual  decimal 
point  in  the  string  if  required. 

LD1 : (load  numeric).  Load  a numeric  field. 

LD2:  (load  postfix  numeric).  Load  a numeric  field 

with  an  internal  trailing  sign. 

LD3 : (load  prefix  numeric).  Load  a numeric  field 

with  an  internal  leading  sign. 

LD4:  (load  separated  postfix  numeri  .cad  a numer- 
ic field  with  a separate  leading  sign. 

LD5:  (load  separated  prefix  numeric).  Load  a numeric 
field  with  a separate  trailing  sign. 

LD6:  (load  packed  numeric).  Load  a packed  numeric 

field . 

MED:  (move  into  alphanumeric  edited  field).  The 

edit  -"ask  is  loaded  into  the  <to  address)  to  set  up  the 
move,  and  then  the  <from  address)  information  is  loaded.  The 
program  counter  is  incremented  by  ten. 

Parameters:  <to  address)  <from  address)  Clength  of  move) 
<edit  mask  address)  <edit  mask  length) 

MNE:  (move  into  a numeric  edited  field).  First  the 
edit  mask  is  loaded  into  the  receiving  field,  and  then  the 
information  is  loaded.  Any  decimal  point  alignment  required 
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will  be  performed.  If  truncation  of  significant  digits  is  a 
side  effect,  the  overflow  flag  is  not  set.  The  program 
counter  is  incremented  by  twelve. 

Parameters:  <to  address>  <from  address>  <address  length  of 
move>  <edlt  mask-  address>  <address  mask  length>  <b.yte  to  de- 
cimal count>  <byte  from  decimal  count> 

MOV:  (move  into  an  alphanumeric  field).  The  memory 
field  given  by  the  <to  address>  is  filled  by  the  from  field 
for  the  <move  length>  and  then  filled  with  blanks  in  the 
following  positions  for  the  <fill  count>. 

Parameters:  <to  address>  <from  address>  <address  move 
length>  ^address  fill  count> 

STI:  (store  immediate  register  two).  The  contents  of 
register  two  are  stored  into  register  zero  and  the  decimal 
count  and  sign  indicators  are  set. 

Parameters:  none. 

The  store  instructions  are  grouped  in  the  same  order 
as  the  load  instructions.  Register  two  is  stored  into 
memory  at  the  indicated  location.  Alignment  is  performed 
and  any  truncation  of  leading  digits  causes  the  overflow 
flag  to  be  set.  All  five  of  the  store  instructions  cause 
the  program  counter  to  be  incremented  by  four.  The  format 
for  these  instructions  is  as  follows. 

Parameters:  <address  to  store  lnto>  <byte  length>  <byte  de- 
cimal count> 
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field  with  an  internal  trailing  sign. 

ST2:  (store  prefix  numeric).  Store  into  a numeric 

with  an  internal  leading  sign. 

STS:  (store  separated  postfix  numeric).  Store  into  a 
numeric  field  with  a separate  trailing  sign. 

ST4:  (store  separated  prefix  numeric).  Store  into  a 
numeric  field  with  a separate  leading  sign. 

STS:  (store  packed  numeric).  Store  into  a packed 

numeric  field. 

5 . Input-Output 


The  following  instructions  perform  input  and  output 
operations.  Tiles  are  defined  as  having  the  following 
characteristics:  they  are  either  sequential  or  random 
and,  in  general,  files  created  in  one  mode  are  not  required 
to  be  readable  in  the  other  mode.  Standard  files  consist 
of  fixed  length  records,  and  variable  length  files  need  not 
be  readable  in  a random  mode.  Further,  there  must  be 
some  character  or  character  string  that  delimits  a variable 
length  record  . 


A.CC : (accept).  Read  from  the  system  input  device 
memory  at  the  location  given  by  the  <memory  address>.  The 
program  counter  is  incremented  by  three. 

Parameters:  <memory  address>  <byte  length  of  read> 

CLS:  (close).  Close  the  file  whose  file  control 
block  is  addressed  by  the  <fcb  address>.  The  program  counter 
is  incremented  by  two. 
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Parameters:  <fcb  address> 

DIS : (display).  Print  the  contents  of  the  data  field 
pointed  to  hy  <memory  address>  on  the  system  output  device 
for  the  indicated  length  and  advance  the  line  output  if 
<flag>  is  set.  The  program  counter  is  incremented  by  four. 
Parameters:  <memory  address>  <byte  length>  <flag> 

There  are  three  open  instructions  with  the  same  for- 
mat. In  each  case,  the  file  defined  by  the  file  control 
block  referenced  will  be  opened  for  the  mode  indicated.  The 
program  counter  is  incremented  by  two. 

Parameters:  <fcb  address> 

OPN:  (open  a file  for  input). 

0?1 : (open  a file  for  output). 

0P2:  (open  a file  for  both  input  and  output).  This 
is  only  valid  for  files  on  a random  access  device. 

The  following  file  actions  all  share  the  same  for- 
mat. Zach  performs  a file  action  on  the  file  referenced  by 
the  file  control  block.  The  record  to  be  acted  upon  is 
given  by  the  <record  address>.  The  program  counter  is  in- 
cremented by  six. 

Parameters:  <?CB  address)  Crecord  address)  <record  length  - 

address). 

BLS : (delete  a record  from  a sequential  file).  Re- 
move the  record  that  was  Just  read  from  the  file.  The  file 
is  required  to  be  open  in  the  input-output  mode. 

RD7:  (read  a sequential  file).  Read  the  next  record 
into  the  memory  area. 
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VTF:  (write  a record  to  a seauential  file).  Append  a 
new  record  to  the  file. 

RVL:  (read  a variable  length  record). 

WVL:  (write  a variable  length  record). 

RWS : (rewrite  sequential).  The  rewrite  operation 
writes  a record  from  memory  to  the  file,  overlaying  the  last 
record  that  was  read  from  the  device.  The  file  must  be  open 
in  the  input-output  mode. 

The  following  file  actions  require  random  files 
rather  than  sequential  files.  They  make  use  of  a random  file 
pointer  which  consists  of  a <relative  address>  and  a Re- 
lative length>.  The  memory  field  holds  the  number  to  be 
used  in  disk  operations  or  contains  the  relative  record 
number  of  the  last  disk  action.  The  relative  record  number 
is  an  index  into  the  file  which  addresses  the  record  being 
accessed.  After  the  file  action,  the  program  counter 
is  incremented  by  nine. 

Parameters:  <FCB  address>  Record  address>  Record  length  - 

adiress>  Relative  address>  Relative  length  - byte>. 

DLR:  (delete  a random  record).  Delete  the  record  ad- 
dressed by  the  relative  record  number. 

RRR:  (read  random  relative).  Read  a rardom  record 
relative  to  the  record  number. 

RRS : (read  random  sequential).  Read  the  next  sequen- 
tial record  from  a random  file.  The  relative  record  number 
of  the  record  read  is  loaded  into  the  memory  reference. 

RWR : (rewrite  a random  record). 


WRR : (write  random  relative).  Write  a record  into 
the  area  indicated  by  the  memory  reference. 

WRS:  (write  random  sequential).  Write  the  next 
sequential  record  to  a random  file.  The  relative  record 
number  is  returned. 

6 . Special  Instructions 

The  remaining  instructions  perform  special  functions 
required  by  the  machine  that  do  not  relate  to  any  of  the 
previous  groups. 

N5G:  (negate).  Complement  the  value  of  the  branch 

flag. 

Parameters:  No  parameters  are  reouired. 

LDI:  (load  a code  address  direct).  Load  the  code 
address  located  five  bytes  after  the  LDI  instruction  with 
the  contents  of  <memory  address^  after  it  has  been  converted 
to  hexideclmal. 

Parameters:  <memory  address>  <length  - byte> 

SCR:  (calculate  a subscript).  Load  the  subscript 
stack  with  the  value  Indicated  from  memory.  The  address 
loaded  into  the  stack  is  the  <initial  address>  plus  an 
offset.  Multiplying  the  <field  length>  by  the  number  in  the 
Cmemory  reference>  gives  the  offset  value. 

Parameters:  <initial  address>  <field  length>  <memory  refer- 
ence>  Cmemory  length)  Cstack  level) 

STD:  (stop  display).  Display  the  Indicated  informa- 
tion and  then  terminate  the  actions  of  the  machine. 


Parameters:  <memory  address>  <length  - byte> 


STP:  (stop).  Terminate  the  actions  of  the  machine. 
Parameters:  no  parameters  are  required.  The  following  in- 
structions are  used  in  setting  up  the  machine  environment 
and  cannot  he  used  in  the  normal  execution  of  the  machine. 

EST:  ( backstuf f ) . Hesolve  a reference  to  a label. 

Labels  may  be  referenced  prior  to  their  definition,  requir- 
ing a chain  of  resolution  addresses  to  be  maintained  in  the 
code.  The  latest  location  to  be  resolved  is  maintained  in 
the  symbol  table  and  a pointer  at  that  location  indicates 
the  next  previous  location  to  be  resolved.  A zero  pointer 
indicates  no  prior  occurrences  of  the  label.  The  code  ad- 
dress referenced  by  <change  address>  is  examined  and  if 


it  contains 

zero,  it  is 

loaded  with  the  <new 

address>. 

If 

it  is 

not 

zero,  then 

the 

contents  are 

saved,  and 

the 

process 

is 

repeated  with 

the 

saved  value  as 

the  change 

ad- 

dress  after  loading  the  <nev  address>. 

Parameters:  <change  address>  <nev  address> 

1ST:  (initialize  memory).  Load  memory  with  the  <in- 
put  striag>  for  the  given  length  at  the  <memory  address>. 
Parameters:  <memory  address>  <address  length>  <input 

string> 

SCD:  (start  code).  Set  the  Initial  value  of  the  pro- 
gram counter. 

Parameters:  <start  address> 

TEH:  (terminate).  Terminate  the  initialization  pro- 
cess and  start  executing  code. 


IV. 


Initially  it  appeared  that  the  debugging  of  the  compiler 
and  interpreter  would  be  straight  forward.  However,  it 
became  apparent  that  a systematic  approach  would  have  to  be 
adopted  in  order  to  meet  the  objectives.  As  previously 
stated,  the  first  step  was  to  determine  the  degree  to  which 
the  compiler  had  been  developed.  After  accomplishing  this 
task,  the  next  step  was  to  identify  the  means  by  which 
errors  could  be  located  and  the  methods  by  which  solutions 
could  be  implemented  and  tested. 

The  method  used  to  identify  errors  within  the  compiler 
consisted  of  the  following:  1.)  compiling  test  programs  and 
denoting  any  compilation  errors  and  2.)  examination  of  the 
symbol  table  construction  and  intermediate  code  instructions 
generated  by  compiling  through  the  DATA  DIVISION  of  a source 
program . 

A minimum  of  forty-five  minutes  was  required  to 
recompile  either  module  — PART  ONI  or  PART  TWO  — of  the 
compiler  after  making  changes,  because  the  object  code 
produced  by  the  compiler  had  to  be  linked  and  loaded.  This 
indicated  a need  to  find  and  use  an  alternative  approach  for 
testing  proposed  changes.  The  approach  used,  was  to  test 
compiler  and  interpreter  modifications  by  using  interactive 
debugging  tools  before  changing  the  compiler's  source  code 
and  recompiling.  This  reduced  the  amount  of  time  that  would 


otherwise  have  been  required  by  reducing  the  total  number  of 
recompilations . 


F 


k . DEBUGGING  METHODOLOGY 

The  debugging  methodology  utilized,  consisted  of  steps 
similar  to  those  suggested  by  Polya's  problem-solving 
technique  [1 6l . Eirst,  upon  encountering  an  occurrence  of  an 
error,  the  approach  was  to  understand  why  the  error 
occurred.  This  included  determining  what  the  compiler  or 
interpreter  had  done  right  in  its  compilation  o^  execution 
of  a source  program,  followed  by  an  analysis  of  what  the 
compiler  or  interpreter  had  done  incorrectly.  Second,  a 
theory  was  devised  to  explain  the  nature  of  the  error(s), 
along  with  a devised  method,  such  as  a paper  and  pencil  walk 
through  using  different  variables  or  combinations  of 
variables,  to  confirm  the  theory.  Next,  the  plan  concerning 
the  error  was  implemented,  usually  this  was  accomplished  by 
a paper  and  pencil  code  walk  through  followed  by 
recompilation  and  reexecution  of  the  program.  Finally,  a 
solution  was  determined,  reviewed,  and  implemented. 

It  was  observed,  as  in  other  program  debugging  efforts, 
that  a few  errors  gave  most  of  the  difficulties  encountered 
when  debugging.  Upon  several  occasions,  it  was  thought  that 
the  origin  and  all  side  effects  of  an  error  had  been 
discovered;  later  however,  after  having  made  a substantial 
coding  change,  it  was  realized  that  there  was  either  another 
boundary  condition,  circumstance  or  combinatorial  problem 
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giving  rise  to  the  error.  The  result  was  that  of  having  to 
restudy  and  refix  the  error,  which  required  additional  time 
and  effort. 

To  facilitate  the  testing  and  debugging  of  the  compiler 
and  interpreter  several  different  software  tools  were 
utilized.  It  is  difficult  to  say  which  was  the  most 
beneficial?  however,  when  they  were  used  together  the  task 
of  testing  and  debugging  was  significantly  enhanced. 

3.  INTERACTIVE  TOOLS 

Because  the  MICR0-C0E0L  compiler  and  interpreter  were 
implemented  under  the  CP/M  operating  system,  two  CP/M 
debugging  facilities  were  used.  First,  the  Dynamic  Debugging 
Tool  [71,  DDT,  is  a dynamic  interactive  program  which  allows 
testing  and  debugging  of  programs  in  the  CP/M  operation 
system  environment.  The  second  was  the  Symbolic  Instruction 
Debugger  [6],  SID,  which  expands  upon  the  features  of  DTT. 
Specifically,  SID  includes  real-time  breakpoints,  fully 
monitored  execution,  symbolic  disassembly,  assembly,  and 
memory  display  and  fill  functions.  Both  debuggers  were 
designed  to  operate  in  an  interactive  mode  and  each  had 
several  features  and  facilities  in  common  which  enhanced  the 
debugging  effort.  One  feature  which  allowed  the  setting  of 
breakpoints  at  actual  memory  locations  corresponding  to  a 
program's  source  lines  and  symbolic  names  was  used  quite 
•ttetisi vely.  Another  useful  facility  was  the  ability  to 
3. a/  ani  alter  the  programs  symbolic  values,  which 
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enabled  the  substitution  of  values  to  check  a proposed 
solution  to  an  error. 

C.  CROSS  REFERENCE  LISTINGS 

Another  useful  facility  which  eased  the  debugging  effort 
was  the  cross  reference  listings  produced  by  the  PLM80 
compiler  used  to  compile  the  MICRC-COBCL  compiler  and 
Interpreter.  There  were  three  different  listings  produced 
after  each  compilation:  1.)  a line  numbered  source  listing, 

2. )  a symbol  address  table,  which  included  the  name  and 
actual  memory  address  assigned  for  all  symbols  declared,  and 

3. )  a line  address  table  which  cross  referenced  every  line 
in  the  source  listing  with  the  9080  code  generated  by  the 
PLM80  compiler  for  that  particular  line.  These  listings  were 
almost  indispensable  with  regard  to  testing  and  debugging, 
and  their  contribution  cannot  be  overemphasized. 

D.  VALIDATION  TESTS 

At  the  onset  of  this  thesis  project  it  was  very 
difficult  to  decide  how  to  test  various  constructs  and 
features  of  the  MICRO-CCBOL  compiler  and  interpreter  and 
there  were  questions  regarding  test  case  design.  During 
earlier  work  [15]  , the  HYPO-COBOL  Compiler  Validation  System 
IHCCVS)  Tape  (from  the  Automated  Data  Processing  Equipment 
Selection  Office  (ADPESC))  was  acquired  — to  be  used  in 
validating  the  MICR0-C0BGL  compiler.  However,  the  HCCVS  was 


never  used  and  the  tape  had  not  been  transferred  to  the 
appropriate  media.  This  transfer  was  accomplished  later 
[12].  By  using  the  HCCVS  as  the  evaluation  package,  the 
auestions  regarding  test  case  construction  and  design  were 
resolved  and  testing  proceeded.  The  HCCVS  was  used  primarily 
as  a test  bed  for  PART  ONE  of  the  compiler,  having  as  an 
objective  the  goal  of  ensuring  the  proper  construction  of 
the  symbol  table  and  data  initialization.  Because  some  of 
the  FYPC-C030L  constructs  were  not  implemented  in  the 
MICF.O-COEOL  compiler  (see  Appendix  E)  , the  compilation  of 
any  HCCVS  program  past  the  PROCEDURE  DIVISION  statement  was 
not  successful. 


V . CONCLUSIONS  AND  RECOMMENDATIONS 


A significant  portion  of  the  MICRO-COBOL 
Compiler/Interpreter  has  been  tested,  debugged  and 
documented.  The  following  specific  language  features  and 
facilities  previously  not  implemented,  or  implemented 
incorrectly,  have  been  successfully  implemented,  tested  and 
debugged  during  this  project:  1.)  the  compiler's  ability  to 
handle  any  sequence  of  MICRO-COBOL  language  constructs 
(PICTURE  CLAUSE,  VALUE  CLAUSE,  OCCURS  CLAUSE,  and  USAGE  COMP 
CLAUSE)  in  the  declaration  of  an  identifier,  2.)  record 
identifier  declarations  with  up  to  ten  levels  of  elementary 
field  items,  3.)  record  and  elementary  field  identifier 
redefinitions,  4.)  nested  redefinitions,  and  5.)  error 
message  generation  for  duplicate  identifier  declarations 
within  the  DAT  \ DIVISION. 

Testing  and  debugging  has  been  accomplished  for  all 
presently  implemented  MICPO-COBCL  language  constructs 
occurring  in  the  DATA  DIVISION  of  a source  program. 
Specifically,  testing  was  performed  by  compiling  through  the 
DATA  DIVISION  of  the  first  ten  3CCVS  test  programs. 

In  addition,  the  MICR0-C03CL  compiler  has  been 
completely  documented.  This  documentation  Includes  the 
following:  1.)  module  organization,  2.)  module  interfaces, 
3.)  memory  organization  of  the  Interpreter,  4.)  construction 
and  data  initialization  of  the  symbol  table,  and  5.)  key 


internal  data  structures. 


\ 


Several  areas  remain  which  could  be  improved,  developed 
and  implemented,  to  enhance  the  MICRO-COBOL 
Compiler/Interpreter  system,  these  include:  1.)  correction 
of  the  numerical  algorithms  in  the  interpreter  to  allow  for 
signed-fractional  arithmetic,  2.)  implementation  of  numeric 
editing  capabilities,  3.)  implementation  of  a printer 
control  feature  and  interface,  and  4.)  testing  and  debugging 
of  the  compiler's  ability  to  compile  the  PROCEDURE  DIVISION 
of  the  HCCVS  test  programs. 
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I . ORGANIZATION 


The  compiler  is  designed  to  run  on  an  8080  system  in  an 
interactive  mode  through  the  use  of  a teletype  or  console. 
It  requires  at  least  24K  of  main  memory  and  a mass  storage 
device  for  reading  and  writing.  The  compiler  is  composed  of 
two  parts  , each  of  which  reads  a portion  of  the  Input  file. 
Part  One  reads  the  input  program  to  the  end  of  the  Data 
Division  and  builds  the  symbol  table.  At  the  end  of  the  Data 
Division,  Part  One  is  overlayed  by  Part  Two  which  uses  the 
symbol  table  to  produce  the  code.  The  output  code  is  written 
as  it  is  produced  to  minimize  the  use  of  internal  storage. 

The  BUILD  Program  builds  the  core  image  for  the 
intermediate  code  and  performs  such  functions  as 
backs  tuff  ing  addresses.  BUILD  then  loads  thp  INTERPRETS?, 
addresses.  EUILD  then  transfers  control  to  the  INTRDR 
routine.  The  INTRDR  routine  copies  the  interpreter  into 
memory  and  transfers  control  to  the  Interpreter.  The 
interpreter  is  controlled  by  a large  case  statement  that 
decodes  the  instructions  and  performs  the  required  actions. 

As  a tool  for  debugging  the  compiler  the  DECODE  Program 
was  created;  it  reads  the  Intermediate  code  file  and 
translates  the  instructions  into  mnemonics  followed  by 
parameters . 


■ i 
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This  section  contains  a description  of  each  element  in 


the  language  and  shows  simple  examples  of  their  use.  The 
following  conventions  are  used  in  explaining  the  formats: 
Elements  enclosed  in  broken  braces  < > are  themselves 
complete  entities  and  are  described  elsewhere  in  the  manual. 
Elements  enclosed  in  braces  { } are  choices,  one  of  the 
elements  which  is  to  be  used.  Elements  enclosed  in  brackets 
[ 1 are  optional.  All  elements  In  capital  letters  are 
reserved  words  and  must  be  spelled  exactly. 


User  names  are  indicated  in  lower  case.  These  names  have 
been  restricted  to  12  characters  in  length.  There  is  only 
one  restriction  on  user  names,  the  first  character  must  be 
an  alpha  character.  The  remainder  of  the  user  name  can  have 
any  combination  of  representable  character  in  it. 

The  input  to  the  compiler  does  not  need  to  conform  to 
standard  COBOL  format.  Free  form  input  will  be  accepted  as 
the  default  condition.  If  desired,  sequence  numbers  can  be 
entered  in  the  first  six  positions  of  each  line.  However,  a 
toggle  needs  to  be  set  to  cause  the  compiler  to  ignore  the 
sequence  numbers. 


IDENTIFICATION  DIVISION 


ELEMENT: 

IDENTIFICATION  DIVISION  Format 


FORMAT: 


IDENTIFICATION  DIVISION. 

PROGRAM-ID.  <comment'>. 

[AUTHOR.  <ccmment>.l 
[DATE -WRITTEN  . <comment> 

[SECURITY.  <comment>.] 

DESCRIPTION: 

This  division  provides  information  for  program 
tlfication  for  the  reader.  The  order  of  the  1 
fixed . 

EXAMPLES: 

IDENTIFICATION  DIVISION. 

PROGRAM- ID.  SAMPLE. 

AUTHOR.  MICHAEL-L-RICE. 


iden- 
ines  is 


ENVIRONMENT  DIVISION 


i 


ELEMENT: 

ENVIRONMENT  DIVISION  Format 

FORMAT: 

ENVIRONMENT  DIVISION. 

CONFIGURATION  SECTION. 

SOURCE-COMPUTER.  <comment>  [DEBUGGING  MODE]. 
OBJECT-COMPUTER.  <comment>. 

[INPUT-OUTPUT  SECTION. 

FILE-CONTF.OL . 

<f ile-control-entry>  . . . 

[I -O-CONTROL . 

SAME  flle-name-1  flle-name-2  [file-name-3] 
fflle-name-41  [file-name-5] . ] ] 

DESCRIPTION: 

This  division  determines  the  external  nature  of  a 
file.  In  the  case  of  CP/M  all  of  the  files  used  can 
he  accessed  either  sequentially  or  randomly  except  for 
variable  length  files  which  are  sequential  only.  The 
debugging  mode  is  also  set  by  this  section. 
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<f il e-con trol-entry> 


ELEMENT: 

<f il e-con tro 1-entry > 


FORMAT: 

1. 


SELECT  file-name 

ASSIGN  implementor-name 
[ORGANIZATION  SEQUENTIAL] 
[ACCESS  SEQUENTIAL] . 


2. 


SELECT  file-name 

ASSIGN  implementor-name 
ORGANIZATION  RELATIVE 

[ACCESS  (SEQUENTIAL  [RELATIVE  iata-name] }] . 

(RANDOM  RELATIVE  data-name  } 

DESCRIPTION: 

The  file-control-entry  defines  the  type  of  file  that 
the  program  expects  to  see.  There  is  no  difference  on 
the  diskette,  but  the  type  of  reads  and  writes  that 
are  performed  will  differ.  For  CP/M  the  implementor 

y 
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name  needs  to  conform  to  the  normal  specifications. 
EXAMPLES : 

SELECT  CARDS 

ASSIGN  CARD ,?IL. 

SELECT  R ANDOM-EILE 

ASSIGN  A. RAN 

ORGANIZATION  RELATIVE 


ACCESS  RANDOM  RELATIVE  RAND-ELAG 


DATA  DIVISION 


I 
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ELEMENT: 

DATA  DIVISION  Format 

FORMAT  : 

DATA  DIVISION. 

[FILE  SECTION. 

[FD  file-name 

[BLOCK  integer- 1 RECORDS] 

[RECORD  [integer-2  TO]  integer-31 
[LABEL  RECORDS  {STANDARD}] 

[OMITTED  } 

[VALUE  OF  implemen tor-nane-1  literal-1 

[ implement or-name-2  literal-2]  ...  ]. 
[<record-description-entry>]  ...]  ... 
[WORKING-STORAGE  SECTION. 
[<record-description-en try>]  . . ] 

[LINKAGE  SECTION. 

[<record-description-entry>]  ...  ] 
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DESCRIPTION 


This  is  the  section  that  describes  how  the  data  is 
structured.  There  are  no  major  differences  from  stan- 
dard COBOL  except  for  the  following:  1.  Label 
records  make  no  sense  on  the  diskette  so  no  entry  is 
required.  2.  The  VALUE  OP  clause  likewise  has  no 
meaning  for  CP/M.  3.  The  linkage  section  has  not  been 
implemented . 

If  a record  is  given  two  lengths  as  in  RECORD  12  TO 
128,  the  file  is  taken  to  be  variable  length  and  can 
only  be  accessed  in  the  sequential  mode.  See  the  sec- 
tion on  files  for  more  information. 


<ccmment> 


LI 
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ELEMENT: 

<comment> 


FORMAT: 

any  string  of  characters 
DESCRIPTION: 

A comment  is  a string  of  characters.  It  may  include 
anything  other  than  a period  followed  hy  a blank  or  a 
reserved  word,  either  of  which  terminate  the  string. 
Comments  may  be  empty  if  desired,  but  the  terminator 
is  still  required  by  the  program. 

EXAMPLES : 

this  is  a comment 

an o the ronea 11 run together 

8080b  16X 


3? 


<da ta-de script! on-entry > 


ELEMENT: 

<d ata-descrlption-entry>  Format 


FORMAT: 

level-number  {data-name} 

{FILLER  } 

{REDEFINES  data-namel 
[PIC  character-string] 

[USAGE  {COMP  }] 

{ DISPLAY } 

[SIGN  {LEADING}  [SEPARATE! ] 

{TRAILING} 

[OCCURS  integer] 

[SYNC  [LEFT  ]] 

[RIGHT] 

[VALUE  literal] . 

DESCRIPTION: 

This  statement  describes  the  specific  attributes  of 
the  data.  Since  the  8080  Is  a byte  machine,  there  was 
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no  meaning  to  the  SYNC  clause,  and  thus  It 
been  implemented. 


has  not 


EXAMPLES : 

01  CARD-RECORD. 

02  PARI  PIC  X ( 5) . 

02  NEXT-PART  PIC  99V99  USAGE  COMP. 

02  PILLYR. 

03  NUMB  PIC  S9(3)V9  SIGN  LEADING  SEPARATE. 
03  LONG-NUMB  9(15). 

03  STRING  REDEPINES  LONG-NUMB  PIC  X(15). 

02  ARRAY  PIC  99  OCCURS  100. 


99 


<sentence> 


ELEMENT: 

<sentence> 

FORMAT: 

<imperat ive-statement> 

<c  ond  i t i ona  1 -s  ta  t em  en  t > 

ENTER  verb 
DESCRIPTION: 

All  sentences  other  than  ENTER  fall  In  one  of  the  two 
main  catigories.  ENTER  is  part  of  the  Interprogram 
communication  module. 


<imperative-statement> 


ELEMENT: 

<imperat ive-statement > 

FORMAT: 

The  following  verbs  are  always  imperatives: 

ACCEPT 

CALL 

CLOSE 

DISPLAY 

EXIT 

SO 

MOVE 

OPEN 

PERFORM 

STOP 

The  following  may  he  imperatives: 

arithmetic  verbs  without  the  SIZE  ESRCR  statement 

and  DELETE,  WRITE,  and  REWRITE  without  the  INVALID  option. 


| 
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<conditional-statements> 


ELEMENT: 

<conditional-statements> 

FORMAT: 

IF 

READ 

arithmetic  verbs  with  the  SIZE  ERROR  statement 

and  DELETE.  WRITE,  and  REWRITE  with  the  INVALID  option 


ACCEPT 


ELEMENT: 

ACCEPT 

9 

FOPMAT: 

ACCEPT  Cidentif ier> 

DESCRIPTION: 

This  statement  reads  up  to  255  characters  from  the 
console.  The  usage  of  the  item  must  be  DISPLAT. 
EXAMPLES  : 

ACCEPT  IMMACE 

ACCEPT  NUM(3) 


ADD 


ELEMENT: 

ADD 

FORMAT : 

ADD  {Identifier}  [{ldentlf ier-l}1  TO  identifier-2 
{literal  } {literal  } 

[ROUNDED]  [SIZE  EFROP.  <imperatlve-statement>1 
DESCRIPTION: 

This  instruction  adds  either  one  or  two  numbers  to  a 
third  with  the  result  being  placed  in  the  last  loca- 
tion. 

EXAMPLES: 

ADD  10  TC  NUM31 

ADD  X Y TO  Z ROUNDED. 

ADD  100  TC  NUMBER  SIZE  ERROR  GO  ERROR-LOC 
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ELEMENT: 


CALL 

FORMAT: 

CALL  literal  [USING  namel  [name2]  . 
DESCRIPTION: 


. [name5l] 


CALL  is  not  implemented. 


CLOSE 


ELEMENT: 

CLOSE 

FORMAT : 

CLOSE  file-name 
DESCRIPTION : 

Files  must  be  closed  if  they  have  been  written.  How- 
ever, the  normal  requirement  to  close  an  input  file 
prior  to  the  end  of  processing  does  not  exist. 
EXAMPLES: 

CLOSE  FI  LEI 

CLOSE  RANDFILE 


DELETE 


ELEMENT: 

DELETE 

FORMAT: 

DELETE  file-name  [INVALID  <imperative-statement>] 
DESCRIPTION: 

This  statement  requires  the  file-name  of  the  item 
to  he  deleted.  The  record  is  logically  removed  by 
filling  it  with  a high  value  character,  which  is  not 
displayable  to  the  console  or  line  printer.  The  log- 
ical record  space  can  be  used  again  by  writing  a 
valid  record  ir.  its  place. 

EXAMPLES : 

DELETE  EILE-N AME 


a 


DIVIDE 


ELEMENT : 


DIVIDE 


FORMAT: 


DIVIDE  {identifier}'  INTO  identifier-l  [ROUNDED] 


{literal  } 


[SIZE  ERROR  imperative-statement  >] 


DESCRIPTION: 


The  result  of  the  division  is  stored  in  identifier-l; 
any  remainder  is  lost. 


EXAMPLES : 


DIVIDE  NUMB  INTO  STORE 


DIYIDI  25  INTO  RESULT 


1 


ELEMENT: 


ENTER 


FORMAT 


ENTER  language-name  [routine-name] 


DESCRIPTION 


EXIT 


ELEMENT: 

EXIT 

FORMAT: 

EXIT  [PROGRAM! 

DESCRIPTION: 

The  EXIT  command  causes  no  action  by  the  interpreter 
but  allows  for  an  empty  paragraph  for  the  construction 
of  a common  return  point.  The  optional  PROGRAM  state- 
ment is  not  implemented  as  it  is  part  of  the  interpro- 
gram communication  module. 

EXAMPLES  : 

RETURN. 


EXIT. 


GO 


£ 

f 

t 


ELEMENT: 

GO 

FORMAT : 

i 

* • 

GO  procedure-name 

2. 

GO  procedure-1  [procedure-21  •••  procedure-20 
DEPENDING  Identifier 

DESCRIPTION: 

The  GO  command  causes  an  unconditional  branch 
routine  specified.  The  second  form  causes  a 
branch  depending  on  the  value  of  the  contents 
identifier.  The  identifier  must  be  a numeric 
value.  There  can  be  no  more  than  20  procedure 
EXAMPLES: 

GO  ?SAD-C»SD. 

GC  RZAD1  READ2  READ3  DEPENDING  READ-INDEX. 


wmm 


to  the 

forward 

of  the 
integer 

names . 
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IF 


ELEMENT: 

I? 

FORMAT: 

IF  <condition>  {imperative  } ELSE  imperative-2 
{NEXT  SENTENCE} 

DESCRIPTION: 

This  is  the  standard  COBOL  IF  statement.  Note  that 
there  is  no  nesting  of  IF  statements  allowed  since  the 
IF  statement  is  a conditional. 

EXAMPLES : 

IF  A GREATEP  3 ADD  A TO  C ELSE  GO  ERROR-ONE. 

IF  A NOT  NUMERIC  NEXT  SENTENCE  ELSE  MOVE  ZERO  TO  A. 
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MOVE 


ELEMENT: 

MOVE 

EORMAT: 

MOVE  {identifier-1}  TO  identifier-2 
{literal  } 

DESCRIPTION : 

The  standard  list  of  allowable  moves  applies  to  this 
action.  As  a space  saving  feature  of  this  implementa- 
tion, all  numeric  moves  go  through  the  accumulators. 
This  makes  numeric  moves  slower  than  alpha-numeric 
moves,  and  where  possible  they  should  be  avoided.  Any 
move  that  involves  picture  clauses  that  are  exactly 
the  same  can  be  accomplished  as  an  alpha-numeric  move 
if  the  elements  are  redefined  as  alpha-numeric;  also 
all  group  moves  are  alpha-numeric. 

EXAMPLES  : 

MOVE  SPACE  TO  PRINT-LINE. 

MOVE  A ( 1 2 ) TO  B(PTR)  . 
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MULTIPLY 


1 

L 

I 

f 

s 

1 

h i 
I 

l 


r 


i 
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ELEMENT: 

MULTIPLY 

FORMAT: 

MULTIPLY  {identifier}  BY  identlfler-2  [ROUNDED] 
(literal  } 

[SIZS  ERROR  <imperat ive-statement >] 

DESCRIPTION: 

The  multiply  routine  requires  enougn  space  to  calcu- 
late the  result  with  the  full  number  of  decimal  digits 
prior  to  moving  the  result  into  identifier-2.  This 
means  that  a number  with  £ places  after  the  decimal 
multiplied  by  a number  with  6 places  after  the  decimal 
will  generate  a number  with  11  decimal  places  which 
would  overflow  if  there  were  more  than  7 digits  before 
the  decimal  place. 

EXAMPLES : 

MULTIPLY  X BY  Y. 


MULTIPLY  A BY  3(7)  SIZE  ERROR  (JO  OVERFLOW. 


! 

i 

i 
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OPEN 


ELEMENT: 

OPEN 


FORMAT: 


OPEN  {INPUT  file-name  } 
{OUTPUT  file-name} 
{ I — 0 file-name  } 


DESCRIPTION: 

The  three  types  of  OPENS  have  exactly  the  same  effect 
on  the  diskette.  However,  they  do  allow  for  internal 
checking  of  the  other  file  actions.  Tor  example,  a 
write  to  a file  set  open  as  input  will  cause  a fatal 
error . 

EXAMPLES : 

OPEN  INPUT  CARDS. 

OPEN  OUTPUT  REPORT-FILE. 


117 


PERFORM 

ELEMENT: 

PERFORM 

FORMAT: 

1. 

PERFORM  procedure-name  ("THRU  procedure-name-2] 

2. 

PERFORM  procedure-name  [THRU  procedure-r.ame-2] 
{identifier}  TIMES 
{integer  } 

3. 

PERFORM  procedure-name  [THRU  procedure-name-2] 

UNTIL  <condition> 

DESCRIPTION: 

All  three  options  are  supported.  Branching  may  be  ei- 
ther forward  or  backward,  and  the  procedures  called 
may  have  perform  statements  in  them  as  Ion*  as  the  end 
points  do  not  coincide  or  overlap. 

EXAMPLES : 

PERFORM  CPEN-RCUT INE . 
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PERFORM  TOTALS  THRU  END-REPORT 


PERFORM  SUM  10  TIMES. 

PERFORM  SKIP-LINE  UNTIL  PG-CNT  GREATER  60. 


READ 


ELEMENT: 

READ 

FORMAT: 

1. 

READ  file-name  INVALID  <imperat  i ve-s  ta  tement> 

2. 

•\ 

READ  file-name  END  ^imperative-statemenO 

| } 

DESCRIPTION: 

The  Invalid  condition  is  only  applicable  to  files  in  a 
random  mode.  All  sequential  files  must  have  an  END 
statement . 

EXAMPLES  : 

READ  CARDS  END  GO  END-OF-FILE. 


READ  RANDOM-FILE  INVALID  MOVE  SPACES  TO  PSC-1. 


REWRITS 


ELEMENT: 


P.EWPITE 


FORMAT: 


..E WRITE  record-name  [INVALID  Cimpera ti ve>] 


DESCRIPTION: 


REWRITE  is  only  valid  for  files  that  are  open  in  the 
1-0  mode.  The  INVALID  clause  is  only  valid  for  random 
files.  This  statement  results  in  the  current  record 
being  written  hacic  into  the  place  that  it  was  Just 
read  from,  the  last  executed  read. 


EXAMPLES : 


REWRITE  CARDS. 


REWRITE  ? » ND-1  INVALID  PERFORM  SRRCR-CHECX. 


STOP 


ELEMENT: 

STOP 


FORMAT: 

STOP  {RON  } 

{literal} 

DESCRIPTION: 

This  statement  ends  the  running  of  the  interpreter. 
If  a literal  is  specified,  then  the  literal  is 
displayed  on  the  console  prior  to  termination  of  the 
pr  ogram. 

EXAMPLES: 

STOP  RUN  . 

STOP  1. 

STOP  "INVALID  FINISH". 


SUBTRACT 


ELEMENT: 

SUBTRACT 

FORMAT: 

SUBTRACT  {identifier-1}  [identifier-2]  FROM  identifier-3 
{literal-1  } [literal-2  ] 

[ROUNDEST  [SIZE  ERROR  <imperatlve-sta tement>] 
DESCRIPTION: 

Identifier-3  is  decremented  by  the  value  of 
ident if ier/1 itera 1 one,  and,  if  specified, 

identifier/literal  two.  The  results  are  stored  back 
xa  identifier-3.  Rounding  and  size  error  options  are 
available  if  desired. 

EXAMPLES : 

SUBTRACT  10  FROM  SU3(12). 

SUBTRACT  A B FROM  C ROUNDED. 
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WRITS 


ELEMENT: 


WRITE 

FORMAT: 

1. 


WRITE  record-name  [{BEFORE}  ADVANCING  {INTEGER}} 

{AFTER  } {PAGE  } 


2. 


WRITE  record-name  INVALIT  <imperative-statement> 
DESCRIPTION: 

The  record  specified  is  written  to  the  file 
specified  in  the  file  section  of  the  source 
program.  The  INVALID  option  only  applies  to 
random  files. 

EXAMPLES: 

WRITE  OUT-FILS. 


WRIT?  FAND-FILE  INVALID  PERFORM  ERROR-RECOV. 


<condition> 


ELEMENT: 

Cconditi on> 


FORMAT: 

RELATIONAL  CONDITION: 

{identifier-1}  [NOT!  {CREATE?}  {identif ier-2} 
{literal-1}  {LESS  } {literal-2  } 

{EQUAL  } 


CLASS  CONDITION: 

identifier  [NOT]  {NUMERIC  } * 

* 

f ALPHABETIC } 

DESCRIPTION: 

It  is  not  valid  to  compare  two  literals.  The 
condition  NUMERIC  will  allow  for  a sign  if  the 
tifler  is  signed  numeric. 

EXAMPLES : 

A NOT  LESS  10. 

LINE  CHESTER  'C*. 

NUMR1  NOT  NUMERIC 
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class 

iden- 


Subscri pting 


I 


\. 


ELEMENT: 

Subscripting 
FORMAT : 

data-name  (subscript) 

DESCRIPTION: 

Any  item  defined  with  an  OCCURS  may  be  referenced  by 
a subscript.  The  subscript  may  be  a literal  integer, 
or  it  may  be  a data  item  that  has  been  specified  as  an 
integer.  If  the  subscript  is  signed,  the  sign  must  be 
positive  at  the  time  cf  its  use. 

EXAMPLES : 

A ( 1 0 ) 

ITSM(SU3) 


I 
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III. 


■ 


COMPILER  TOGGLES 

There  are  four  compiler  toggles  which  are  controlled  by 
an  entry  following  the  compiler  activation  command,  COBOL 
<filename>.  The  format  of  the  entry  consists  of  following 
<filename>  by  one  space  and  then  entering  a followed 
immediately  by  the  desired  toggles.  There  must  be  only  one 
space  after  <filename>  and  no  spaces  between  the  and  the 
toggles.  The  following  is  an  example  of  a typical  entry: 
COBOL  EXAMPLE  $ST 

This  entry  would  cause  the  compiler  to  ignore  the  sequence 
numbers  entered  at  the  beginning  of  each  input  file  line  and 
print  the  token  numbers  to  the  output  device.  In  each  case 
the  toggle  reverses  the  default  value. 

$L  — list  the  input  code  on  the  screen  as  the  program 
is  compiled.  Default  is  on.  Error  messages  will  be  difficult 
to  understand  if  this  toggle  is  turned  off,  but  if  the 
interface  device  is  a teletype,  it  may  be  desired  in  certain 
si tua  tions . 

$S  — sequence  numbers  are  in  the  first  six  positions  of 

i 

each  record.  Default  is  off. 

$?  — list  productions  as  they  occur.  Default  is  off. 

$T  — list  tokens  from  the  scanner.  Default  is  off. 
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17.  RUN  TIMS  CONVENTIONS 


This  section  explains  how  to  run  the  compiler  on  the 
current  system.  The  compiler  expects  to  see  a file  with  a 
type  of  CBL  as  the  input  file.  In  general,  the  input  is  free 
form.  If  the  input  includes  sequence  numbers  then  the 
compiler  must  be  notified  by  setting  the  appropriate  toggle. 
The  compiler  is  started  by  typing  COBOL  <file-name>.  Where 
the  file  name  is  the  system  name  of  the  input  file.  There  is 
no  interaction  required  to  start  the  second  part  of  the 
compiler.  The  output  file  will  have  the  same  <file-name>  as 
the  input  file,  and  will  be  eiven  a file  type  of  CIN.  Any 
previous  copies  of  the  file  will  be  erased. 

The  interpreter  is  started  by  typing  EXEC  <filename>. 
The  first  program  is  a loader,  and  it  will  display  "LOAD 
FINISHED'  to  indicate  successful  completion.  The  run-time 
package  will  be  brought  in  by  the  INTRDR  routine,  and 
execution  should  continue  without  interuption. 


The  file  structure  that  is  expected  by  the  program 
imposes  some  restrictions  on  the  system.  References  4 and  5 
contain  detailed  information  on  the  facilities  of  CP/M,  and 
should  be  consulted  for  details.  The  Information  that  has 
been  included  in  this  section  is  Intended  to  explain  where 
limitations  exist  and  how  the  program  interacts  with  the 
system. 

All  files  in  CP/M  are  on  a random  access  device,  and 
there  is  no  way  for  the  system  to  distinguish  sequential 
files  from  files  created  in  a random  mode.  This  means  that 
the  various  types  of  reads  and  writes  are  all  valid  to  any 
file  that  has  fixed  length  records.  The  restrictions  of  the 
ASSIGN  statement  do  prevent  a file  from  being  open  for  both 
random  and  sequential  actions  during  one  program. 

Each  logical  record  is  terminated  by  a carriage  return 
and  a line  feed.  In  the  case  of  variable  length  records, 
this  is  the  only  end  mark  that  exists.  This  convention  was 
adopted  to  allow  the  various  programs  which  are  used  in  CP/M 
to  work  with  the  files.  Files  created  by  the  editor,  for 
example,  will  generally  be  variable  length  files.  This 
convention  does  remove  the  capability  of  reading  variable 
length  files  in  a random  mode. 

All  of  the  physical  records  are  123  bytes  in  length,  and 
the  program  supplies  buffer  space  for  these  records  in 
addition  to  the  logical  records.  Logical  records  may  be  of 
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VI.  EPROE  MESSAGES 

A.  COMPILER  FATAL  MESSAGES 

BR  Bad  read  — disk  error,  no  corrective  action  can  be 
taken  in  the  program. 

CL  Close  error  — unable  to  close  the  output  file. 

MA  Make  error  — could  not  create  the  output  file. 

MO  Memory  overflow  — the  code  and  constants  generated 

will  not  fit  in  the  alloted  memory  space. 

OP  Open  error  — can  not  open  the  input  file,  or  no  such 
file  present. 

SO  Stack  overflow  — the  LALR(l)  parsing  stack  has  exceeded 
its  maximum  allowable  size. 

ST  Symbol  table  overflow  — symbol  table  is  too  large  for 
the  allocated  space. 

WE  Write  error  — disk  error,  could  not  write  a code 

record  to  the  disk. 

3.  COMPILER  WARNINGS 

Cl  Close  error  — attempted  to  close  a non-existing  file. 

DC  Decimal  count  error  — decimal  significance  is  greater 
than  IS  digits. 

DI  Duplicate  identifier  — the  identifier  name  has  been 


1 
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previously  declared  in  the  WORKING  STORAGE  area  of  the 
program . 

EF  Excess  files  — the  number  of  files  declared  in  the 
source  program  exceeds  24. 

EL  Extra  levels  — only  10  levels  are  allowed. 

FT  File  type  — the  data  element  used  in  a read  or  write 

statement  is  not  a file  name. 

IA  Invalid  access  — the  specified  options  are  not  an 

allowable  combination. 

H 

ID  Identifier  stack  overflow  — more  than  20  items  in  a 
GO  TO  — DEPENDING  statement. 

IS  Invalid  subscript  — an  item  was  subscripted  but  it 

was  not  defined  by  an  OCCURS. 

IT  Invalid  type  — the  field  types  do  not  match  for  this 

statement . 

LE  Literal  error  — a literal  value  was  assigned  to  an 

item  that  is  part  of  a group  item  previously  assigned 
a value. 

LV  Literal  value  error  — the  PICTURE  clause  field  type 
does  not  match  the  VALUE  clause  literal  type. 

MD  Multiple  decimals  — a numeric  literal  in  a VALUE 
clause  contains  more  than  one  decimal  point. 

MS  Multiple  signs  — a signed  numeric  literal  in  a VALUE 
clause  contains  more  than  one  sign. 

NF  Nc  file  assigned  — there  was  no  SELECT  clause  for 

\ i 

this  file. 


' 


MI 


Not  implemented  — a production  was  used  that  is  not 
implemen  ted . 

Non-numeric  — an  invalid  character  was  found  in  a 


NN 

numeric  string. 

NP  No  production  — no  production  exists  for  the  cuurrent 
parser  configuration;  error  recovery  will  automatically 
occur. 

NV  Numeric  value  — a numeric  value  was  assigned  to  a 

non-numeric  item. 

OS  Open  error  — attempt  to  open  a file  that  was  not  de- 
clared; or  attempted  to  open  a file  for  1-0  that  was 
not  a RELATITS  file. 

PC  Picture  clause  — an  invalid  character  or  set  of 
characters  exists  in  the  picture  clause. 

P?  Paragraph  first  — a section  header  was  produced  after 
a paragraph  header,  which  is  not  in  a section. 

R1  Redefine  nesting  — a redefinition  was  made  for  an 

item  which  is  part  of  a redefined  item. 

R2  Redefine  length  — the  length  of  the  redefinition  item 
was  greater  than  the  item  that  it  redefined.  This  error 
message  may  be  printed  out  one  identifier  past  the 
redefining  identifier  record  in  which  it  occurred. 

R3  Redefines  misplaced  — a redefines  was  attempted  in  the 
FILE  SECTION  of  the  source  program. 

SE  Scanner  error  — the  scanner  was  unable  to  read  an 

Identifier  due  to  an  invalid  character. 

SG  Sign  error  — either  a sign  was  expected  and  not 
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found,  or  a sien  was  present  when  not  valid. 

SL  Significance  loss  — the  number  assigned  as  a value  is 
larger  than  the  field  defined. 

TE  Type  error  — the  type  of  a subscript  index  is  not 
integer  numeric. 

UI  Undeclared  identifier  — the  identifier  was  not 

declared  in  WORKING  STORAGE  area  of  the  source  program. 

VE  Value  error  — a value  statement  was  assigned  to  an 
item  in  the  file  section. 

WL  Wrong  level  error  — program  attempted  to  write  a 
record  other  than  an  01  level  record  to  an  output 
file. 

C.  INTERPRETER  FATAL  ERRORS 

CL  Close  error  — the  system  was  unable  to  close  an  output 
file. 

IE  Make  error  — the  system  was  unable  to  make  an  input 
file  on  the  disk. 

NF  No  file  — an  input  file  could  not  be  opened. 

W1  Write  non-sequential  — attempted  to  WRITE  to  a file 
opened  for  INPUT  or  a file  opened  for  1-0  when  ACCESS 
was  SEQUENTIAL. 

W2  Wrong  key  — attempted  to  change  the  key  value  to  a 
lower  value  than  the  number  of  the  last  record  writ- 
ten. 


lo4 


W3 


W4 

W5 


W6 


W7 


l 

: 

! 
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Write  input  — attempted  to  WRITE  to  a f 4 le  opened 
for  INPUT. 

Write  non-empty  — attempted  to  WRITE  to  a non-empty 
record . 

Read  output  — attempted  to  READ  a file  opened  for 
OUTPUT. 

Rewrite  error  — attempted  to  REWRITE  to  a file 
not  opened  fo  I-O. 

Rewrite  error  — attempted  to  REWRITE  a record  before 
reading  the  file;  or  multiple  REWRITE  attempts  with- 
out doing  a READ  between  each. 


B.  INTERPRETER  WARNING  MESSAGES 


EM  End  marie  — a record  that  was  read  did  not  have  a 

carriage  return  or  a line  feed  in  the  expected  location. 

GD  Go  to  depending  — the  value  of  the  depending  indicator 
was  greater  than  the  number  of  available  branch 
addresse  s . 

IC  In’valid  character  — an  invalid  character  was  loaded 

into  an  output  field  during  an  edited  move.  For  example, 
a numeric  character  into  an  alphabetic-only 
field. 

SI  Sign  Invalid  — the  sign  is  not  a "+"  or  a 

WE  Write  Error  — attempted  to  write  to  an  output  file. 


LIST  OF  MICRO-COBOL  RESERVED  WORDS 


The  following  is 


list  of  reserved  words  for 


R 

s 


MICRO-COBOL.  The  reserved  words  are  the  same  as  those 
specified  for  the  HYPO-COBOL  language,  except  where  noted 
with  an  asterisk  (*) . 


ACCEPT 

ENVIRONMENT 

MULTIPLY 

RUN 

ACCESS 

EOF  * 

NEXT 

SAME 

ADD 

ECUAL 

NOT 

SECTION 

ADVANCING 

ERROR 

NUMERIC 

SECURITY 

AFTER 

EXIT 

OBJECT-COMPUTER 

SELECT 

ALPHABETIC 

JD 

OCCURS 

SENTENCE 

ASSIGN 

FILE 

OF 

SEPARATE 

AUTHOR 

FILE-CONTROL 

OMITTED 

SEQUENTIAL 

BEFORE 

FILLER 

OPEN 

SIGN 

BLOCK 

FROM 

ORGANIZATION 

SIZE 

BY 

GO 

OUTPUT 

SOURCE-COMPUTER 

CALL 

GREATER 

PAGE 

SPACE 

CLOSE 

1-0 

PERFORM 

STANDARD 

COBOL 

I-O-CONTROL 

PIC 

STOP 

COMP 

IDENTIFICATION 

PROCEDURE 

SUBTRACT 

CONFIGURATION 

IF 

PROGRAM 

SYNC 

DATA 

INPUT 

PROGRAM-ID 

THRU 

DATE-WRITTEN 

INPUT-OUTPUT 

QUOTE 

TIMES 

DEBUGGING 

INVALID 

RANDOM 

TO 

DELETE 

INTO 

READ 

TRAILING 

DEPENDING 

LABEL 

RECORD 

UNTIL 

DISPLAY 

LEADING 

RECORDS 

USAGE 

DIVIDE 

LEFT 

REDEFINES 

USING 

DIVISION 

LESS 

RELATIVE 

VALUE 

ELSE 

LINKAGE 

REWRITE 

WORKING-STORAGE 

END 

MODE 

RIGHT 

WRITE 

ENTER 

MOVE 

ROUNDED 

ZERO 
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APPENDIX  C 

The  MICRO-COBOL  compiler  and  interpreter  source  files 
currently  exist  in  the  high  level  language  PLM80  and  are 
edited  and  compiled  under  the  ISIS  operating  system  on  a 
INTEL  Corporation  MDS  system.  This  is  a description  of  the 
procedures  reouired  to  compile  and  establish  the  programs  to 
compile  and  interpret  a MICRO-COBOL  program.  The  MICRO-COBOL 
compiler  and  interpreter  run  on  any  8080  or  Z-80  based 
microcomputer  that  operates  under  CP/M.  The  execution  of  the 
following  four  files  will  cause  a MICRO-CCBOL  program  to  be 
compiled  and  executed: 

1.  C030L.C0M 

2.  PART2.COM 

3.  EXEC.COM 

4.  CINTERP.COM 

These  four  files  are  created  from  the  following  six 
PLM80  source  programs. 

1.  PARTI. PLM 

2.  PART2.PLM 

3.  BUILD. PLM 

4.  IREADER.PLM 

5.  INTRPR.PLM 

6.  INTERP.PLM 

The  procedures  used  to  create  the  four  object  files  (COM 
files)  Involve  compiling,  linkin*,  and  locating  each  of  the 
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six  source  files  under  ISIS.  The  SID  program  Is  then  used 
under  CP/M  to  construct  the  executable  files.  Each  of  the 


i 

•! 

, 1 

ii' 
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following  steps  describe  the  action(s)  to  be  taken  and, 
where  appropriate,  the  command  string  to  be  entered  into  the 
computer . 

1.  An  ISIS  system  disk  containing  the  PLMS0  compiler  is 
placed  into  drive  A and  a non-system  disk  containing  the 
source  programs  is  placed  into  drive  B.  It  should  be  noted 
that  drive  A and  B are  the  CP/M  reference  names  for  the 
drives  while  FI  and  F2  are  the  ISIS  reference  names  used  for 
the  associated  disk  drives. 

2.  Compile  the  PLM  source  program  under  ISIS  using  the 
the  following  command: 

PLM60  :F1 :<f ilename>.PLM  DEBUG  XREF 

DEBUG  saves  the  symbol  table  and  line  files  for  later 
use  during  debugging  sessions.  XR2?  causes  a cross-reference 
listing,  of  all  identifiers  in  the  source  program,  to  be 
created.  The  cross-reference  listing  includes  each 
identifier  and  the  associated  line  number  where  the 
ldentifer  was  declared  and  the  line  number  of  each  occurence 
of  the  Identifier  in  the  source  program  [9]. 

3.  Link  the  PLM80  object  file. 

LIMK  :Fl:<filename>.OBJ.  TRI NT .OBJ  , PLM80.LIB,  TO 

:Fl:<f ilename>.MOD 


See  reference  10  for  an  explanation  of  PLM60.LIB.  The 
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TRINT.OBJ  pregram  interfaces  the  MON1  and  M0N2  functions  of 
CP/M  to  the  source  program,  allowing  for  the  use  of  absolute 
addresses  in  referencing  these  functions. 


4.  Locate  the  object  file. 

LOCATE  :F1  :<f ilename>.MOD  CODE(org  address) 

The  "org  address*  is  the  address  where  the  program  will 
begin  to  be  loaded  into  memory.  The  following  are  "org 
addresses'  for  the  associated  program: 


PARTI. MOD 

100H 

PART2.M0D 

100H 

INTER?. MOD 

100H 

INTRDR. MOD 

e0H 

BUILD. MOD 

100H 

IREADER. MOD 

D000H 

The  "org  addresses”  above  represent  the  ones  used  with  a 621 
byte  CP/M  system.  The  only  address  that  would  need  to  be 
changed  if  a different  size  system  was  used  would  be  the  one 
for  IPSADSP.MOD.  See  appendix  E for  specifics  on  the  address 
to  use  for  IREADER. 

4a.  The  two  files  INTRDR  and  IREADER  Just  created  by  the 
LOCATE  command  must  be  converted  to  "HEX  FILES".  3y  using 
the  ISIS  command  OBJHEX  <filename>  the  file  will  be 
converted  to  the  "HEX  file"  <filename>.HEX . 

5.  Replace  the  ISIS  system  disk  in  drive  A with  a CP/M 
system  disk  and  reboot  the  system. 
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6.  Transfer  the  located  ISIS  file  from  the  ISIS  disk  on 
drive  3 to  the  CP/M  disk  on  drive  A. 

FROMIS IS  <filename> 

6a.  When  transfering  the  "HEX  files"  to  the  CP/M  disk 
use  the  following: 

FROMISIS  <f i lename> .HEX 

7.  Convert  the  ISIS  file  to  a CP/M  executable  form. 

OPJCPM  <filename> 

7a.  The  "HEX  files"  are  not  coverted  to  a CP/M  format, 
hut  are  left  in  the  HEX  format. 

At  this  point  the  object  file  is  in  machine  readable 
form  and  will  run  under  CP/M  when  called  properly.  PART2.COM 
and  CINTERP.COM  are  called  by  PART1.COM  (COBOL.COM)  and 
EXEC.COM,  respectively  and  need  no  further  work.  PART1.COM 
and  EXEC.COM  need  to  be  constructed  from  the  remaining  four 
files . 

PART1.COM  is  created  by  entering  the  following  commands: 

1.  SID  PARTI. CCM 

2.  ISEADE2 .HEX 

3.  R6200 

4.  A2A9A 

5.  JMP  0D00P 

6.  Control-C 

7.  Save  52  COBOL. 


. mm 


See  reference  6 for  an  explanation  of  the  'i',  "r",  and 
"A  ' commands  used  above  and  ref  4 for  an  explanation  of  the 
'SAVE'  command.  Steps  four  and  five  above  are  used  to  patch 
the  JUMP  to  IREADER  referred  to  in  the  PARTI. PLM  program 
into  the  PART1.COM  program. 

EXEC.COM  us  created  by  entering  the  following  commands: 


1.  SID  BUILD.COM 

2.  INTRER .HEX 

3.  R1C0C? 

4.  A1CB5 

5.  JMP  5 

6.  A1CC1 

7.  JMP  5 

8.  CONTROL-C 

9.  SAVE  31  EXEC.COM 

Statements  4,  5,  6,  and  7 above  are  used  to  patch  the 

JUMP  to  BDOS  referred  to  in  the  INTRDR.PLM  program  into  the 
INTRDR.HEX  program. 

NPS  MICP.0-C030L  programs  may  now  be  executed  in  the 
following  manner.  The  source  program  is  named, 

<filename>.C3L.  The  command  "COBOL  <filename>’,  causes  the 
MICRO-COBOL  source  program  to  be  read  into  memory  and 
compiled.  During  the  compilation,  the  intermediate  code 
file,  <f ilenameb.ClM , is  written  out  to  the  disk  as  the  code 
is  generated.  The  command  'EXEC  <filename>',  causes  the 
file,  <f ilename>.CIN,  to  be  executed. 
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APPENDIX  D 

PART  ONE  AND  PART  TWO  INTERNAL  DATA  STRUCTURES 
AND  SIGNIFICANT  VARIABLES 

Within  PART  ONE  and  PART  TWO,  many  significant  data 
structures  are  used  by  the  procedures  which  constitute  the 
scanner  and  parser.  Descriptions  are  given  below  for  those 
structures  regarded  as  important  and  necessary  for  future 
compiler  development. 

1.  Interfacing  Structures 

ADD^END  — this  variable  is  used  to  hold  the  end  of 
file  filler  for  the  end  of  the  source  program. 

BUFFER (11)  — byte  array  used  to  hold  the  filename 
and  filetype  if  declared,  of  an  input  or  output  file  in  the 
SELECT  CLAUSE  of  the  FILE  SECTION  of  a MICR0-C030L  source 
program. 

3UFFER£END  — address  variable  which  marts  the  last 
byte  of  the  compiler  Input  buffer  which  is  a 128  byte  buffer 
used  for  reading  the  source  program. 

IN$ADDR  — address  variable,  default  file  control 
block  used  initially  to  hold  the  <f ilename . C3L>  of  the 
source  program  to  be  compiled. 

IN$BUFF  — literal  value,  marks  the  first  byte  of 
the  compiler  input  buffer. 

INPUT^FCB  — byte  value,  based  at  IN$ADDR(33),  the 
base  address  of  the  default  file  control  block  of  the  source 
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OUTPUT$PUFF( 128 ) — byte  array,  used  as  a 128  byte 
output  buffer  for  loading  the  generated  output  (pseudo 
Instructions)  when  writing  to  the  Intermediate  code  file. 

OUTPUT$CHAR  — byte  value,  based  at  the  OUTPUT$PTR; 
used  to  identify  the  particular  byte  of  the  output  buffer 
(OUTPUT$BUFF)  to  which  the  next  intermediate  code 
instruction  is  to  be  written. 

OUTPUTiEND  — address  variable,  pointer  to  the  end 
of  the  output  buffer  (OUTPUT$EUFF ) . 

0UTPUT$FCB(33 ) — byte  array,  the  FCB  for  the 
intermediate  code  file  <filename.CIN>  established  in  PAST 
ONE  of  the  compiler  and  pasted  to  PART  TWO  of  the  compiler 
by  IREADER  module. 

COTPUT^PTR  — address  value,  used  as  an  index  into 
the  output  buffer  (OUTPUT$EUFF) . 

POINTER  — address  value,  the  address  of  the  byte 
holding  the  next  input  character  of  the  source  program. 

2.  Debugging  Structures 

DEBUGGING  — logical  byte  value,  toggle  used  in 
conjunction  with  in  a MICRO-COBOL  source  program  text; 
allows  for  the  compilation  or  non-compilation  of  the 
deugging  statements  following  the 

LISTSINPUT  — logical  byte  value,  toggle  used  to 
display  or  not  display  a source  program  to  the  CRT  during 
compilation. 


PARMLIST(9)  — byte  array  used  to  hold  the  toggles 
set  by  the  compiler  developer  or  user  upon  execution  of  the 
command:  COBOL  <f ilename.CBL>  $T0GGLES  . 

PRINT$PR0D  — logical  byte  value,  toggle  used  to 
print.  In  chronological  order,  at  the  CRT  the  production 
numbers  of  the  compiler  grammar  rules  used  during  a 
compilation  of  the  source  program. 

SE0$NUM  — logical  byte  value,  toggle  used  to 
indicate  the  presence  of  sequence  numbers  In  the  first  six 
positions  of  each  line  of  a source  program  being  compiled. 

3.  Memory  Structures 

EOTFILLER  — literal  value,  used  to  test  for  the 
occurrence  of  an  end  of  file  character  ("lAH"  in  CP/M),  when 
reading  the  source  program. 

PR STORAGE  — first  free  address  following  PART 
ONE  of  the  compiler;  utilized  as  the  base  of  the  symbol 
table.  This  is  the  same  value  as  HASH$TA3$ADER  In  PART  TWO 
o^  the  compiler. 

INITIALiPCS  — address  value,  the  initial  location 
of  the  IREADER  module  before  It  Is  copied  to  high  memory  at 
location  MAX$MEMORT. 

MAX$MEMORY  — address  value,  the  location  in  high 
memory  where  the  IREADER  module  is  to  be  moved. 

NEXT$AVAILABLE  — address  value,  the  pseudo  machine 
memory  address  for  the  next  machine  instruction. 

PAr.TliLEN  — the  number  of  bytes  of  information 
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saved  in  high  memory  after  execution  of  PART  ONE  and  used  to 
initialize  PART  TWO  module  variables  of  the  compiler. 


PASS1$T0P  — this  address  is  used  in  conjunction 
with  ?ASS1$LEN  for  locating  the  fourty-eight  bytes  of 
information  saved  in  PART  ONE  for  use  in  PART  TWO  of  the 
compiler. 

?DF.$LENGTH  — literal  value  representing  the  255 
bytes  of  the  IREAEER  module  to  be  moved  from  INITIAL$P0S  to 
MAX$MEMORY . 

4.  Scanner  Structures: 

ACCUM( 51 ) — an  array  of  51  bytes;  the  first  byte 
contains  a count  of  the  total  number  of  characters  currently 
in  the  accumulator.  This  structure  holds  tokens  as  they  are 
scanned,  and  will  hold  either  a reserved  word,  a user 
defined  identifier,  or  a literal. 

COLLISION  — address  varible,  contained  in  first  two 
bytes  of  an  Identifier's  symbol  table  entry  and  indicates 
whether  there  is  another  identifier  which  hashes  to  the  same 
hash  table  address.  This  address  points  to  that  Identifier's 
address  in  the  symbol  table. 

DISPLAK 74 ) — an  array  of  74  bytes*  the  first  byte 
contains  a count  of  the  total  number  of  characters  (1-73) 
currently  in  the  display  buffer.  Every  line  within  a source 
nrogram  is  loaded  into  this  structure  for  subsequent 
printing  to  the  CRT  terminal  during  compilation. 

EBIT$?LAG  — logical  flag  which  denotes  the  fact 


► 

if 


! I 

I 


that  a symbol  has  been  loaded  Into  the  DISPLAY  array 
during  compilation.  When  set  the  characters  within  DISPLAY 
will  be  printed  one  at  a time,  until  the  entire  line  is 
printed. 

HASH$TABLE$ADDR  — the  base  of  the  symbol  table 
generated  in  PART  ONE,  used  as  the  base  of  the  hashtable. 

HASH$TABi ADDR  — this  was  the  address  of  the  bottom 
of  the  symbol  table  generated  in  PART  ONE  of  the  compiler, 
and  saved  for  Part  two. 

INPUT$STR  — literal  value  (32),  returned  to  the 
LALR(l)  parser  anytime  the  token  contained  in  the  ACCUM  is 
not  a reserved  word  or  literal. 

LITERAL  — literal  value  (15),  returned  to  the 
LALR(l)  parser  anytime  the  first  character  encountered  by 
the  scanner  is  a quote  ('),  prior  to  loading  the  ACCUM. 

MAX$LEN  — length  of  the  longest  reserved  word 
allowed  by  MICRO-COBOL. 

5.  Parser  Structures: 

BUFFER (31)  — byte  array  used  to  store  edited 
PICTURE  CLAUSE  characters  for  subsequent  intermediated  code 
generation. 

COMPILING  — logical  byte  value  which  indicates  that 
compiling  is  taking  place  or  not  in  PART  ONE  or  PART  TWO; 
set  to  FALSE  whenever  the  statestack  of  the  LALR(l)  parser 
is  reduced  to  a recognizable  finished  state. 

CURiSYM  — address  variable  that  holds  the  address 
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of  the  current  symbol  being  accessed  In  the  symbol  table 


DUP$IDEN$ARRAT(24)  — address  array  that  holds  the 
symbol  address  for  all  files  declared  in  the  INPUT-OUTPUT 
SECTION  of  a source  program.  When  the  PILE  SECTION  entry  for 
the  file  Is  encountered  the  array  is  searched  to  determine 
if  the  file  was  declared  and  to  insure  that  a PILE  SECTION 
entry  had  not  been  previously  made. 

FILE$DESC$FLAG  — logical  byte  value;  indicates 
whether  the  compiler  is  compiling  the  FILE  DESCRIPTION 
SECTION  of  a source  program  or  not. 

FILE$SEC$END  — logical  byte  value  set  whenever  the 
parser  has  parsed  passed  the  FILE  SECTION  of  a source 
program. 

H0LD$LIT(51)  — byte  array,  first  byte  contains  a 
count  of  the  total  number  of  characters  currently  stored  in 
the  HOLDLIT  buffer  which  is  used  to  hold  characters  for  a 
VALUE  CLAUSE. 

ID$STACE(10)  — address  array  which  functions  as  a 
stack  and  is  used  to  hold  the  addresses  of  identifiers  at 
both  the  record  and  elementary  levels.  Whenever  a record 
identifier  has  nested  elementary  field  identifiers  it  is 
saved  on  the  ID$STACK.  Also,  anytime  a record  Identifier  has 
succeeding  record  identifiers  redefining  it,  it  is  saved  on 
the  ID$STACE.  In  the  case  of  multiple  record  descriptions  in 


a file  description  of 

the 

FILE  SECTION, 

the  record 

descriptions  following 

the 

first  record 

are  assumed 

redef ini tions . 
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ID$STACX$?TR  — a byte  index  variable  into  the 
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ID$STACK  array. 

MAX$ID$LEN  — a numeric  value  (12),  maximum  length 
of  any  user  defined  identifier. 

MP  — byte  index  variable  into  the  VALUE  array. 

MPP1  — byte  index  variable  into  the  VALUE  array, 
one  byte  above  MP  index. 

NEXTSSYM  — this  address  indicates  the  next 
available  free  space  for  a symbol  table  entry. 

PENDING$LITERAL  byte  value  ( 0, 1,2 ,3,4 ,5  ) , 

indicates  the  category  of  the  target  input  to  a VALUE 
CLAUSE. 

PENDI NG$LIT$ ID  — byte  value  ( 0, 1 , 2, 3,4,5 ) , which  is 
saved  tc  indicate  the  category  of  the  most  recently 
encountered  target  input  to  a VALUE  CLAUSE. 

PRODUCTION  — byte  value,  determined  by  the  parser 
and  Indicates  the  next  semantic  action  to  be  taken  by  the 
compi ler . 

REIEE  — logical  byte  value  which  allows  the  testing 
of  an  identifier's  storage  value  size  against  the  storage 
value  size  of  a second  identifier  that  redefines  the  first. 
Set  to  TRUE  when  there  are  multiple  record  descriptions 
within  a ?D  RLOCX  in  the  FILE  SECTION,  or  when  a record  or 
elementary  identifier  declaration  in  the  WORKING  STORAGE 
SECTION  contains  a REDEFINES  CLAUSE. 

REDEFiFLAG  — logical  byte  value,  used  to  denote  the 
scanning  and  parsing  of  the  FILS  SECTION  of  a source 
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program,  helps  in  Identifying  duplicate  identifiers  within 
this  section. 


P.EDEE$ONE  — address  variable  that  holds  the  symbol 
table  address  of  the  identifier  being  redefined  by  another 
identifier . 

F.EDEF$TWC  — an  address  variable  that  contains  the 
symbol  table  address  of  an  identifier  which  redefines 
another  identifier. 

SP  — a byte  index  for  the  STATESTA.CK  array  and  the 
VALUE  array?  points  to  the  top  of  the  STATESTACK  array. 

STATE  — a byte  value  numeric  quantity  that 
indicates  the  current  parser  state. 

STATES TACK(30 ) — a byte  array  which  stacks  the 
states  (production  sequences)  the  parser  passes  through 


while  compiling  a source  program. 

T?.UNC$FLAG  — logical  byte  value  that  indicates 
numeric  truncation  of  an  identifier's  VALUE  CLAUSE  input 
hasn't  occurred,  because  the  identifier's  associated  PICTUFE 
CLAUSE  has  not  been  scanned  and  parsed. 

VALUE(30)  — an  address  array  that  holds  addresses 
of  identifiers,  specific  attributes  of  these  identifiers  and 
attributes  of  the  current  source  program  statement  or 
sentence  being  parsed. 

VARC(51)  — a byte  array,  the  first  byte  holds  the 
count  of  the  total  number  of  characters  within  it,  used  to 
hold  all  the  ASCII  characters  of  tokens  scanned  within  the 
source  program,  excluding  reserved  words?  for  subsequent 
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analysis  and  processing 


VALUE$?LAG  — a logical  byte  that  Is  set  anytime  an 
Identifier  has  an  associated  VALUE  CLAUSE;  used  primarily  to 
recognize  the  occurrence  of  a PICTURE  CLAUSE  before  the 
VALUE  CLAUSE  or  when  a record  entry  has  a VALUE  CLAUSE,  but 
no  associated  PICTURE  CLAUSE  except  for  those  in  its 
elementary  field  identifiers. 

VALUESLEVEL  — a byte  value  which  saves  the  level 
number  of  a record  identifier  which  doesn't  have  an 
associated  PICTURE  CLAUSE. 


APPENDIX  E 

The  NPS  MICRO-COBOL  compller/lnterpreter  is  designed  to 
operate  on  any  8080  or  Z80  based  microcomputer  operating 
under  CP/M  with  at  least  20K  bytes  of  memory.  The  PLM80 
source  files  have  been  written  in  such  a way,  that  certain 
variables  must  be  altered  in  the  source  code  to  take 
advantage  of  the  machine  that  the  programs  are  going  to  be 
operating  on.  This  appendix  covers  those  programs  and  the 
variables  that  must  be  altered. 

1.  PARTI. PLM 

This  program  has  two  variables  that  are  memory  size 
dependent,  MAXSMEMORT  and  MAX$INT$MEMCRT.  The  variable 
MAX$MEMORT  is  set  to  100H  bytes  below  the  base  of  the  BTCS 
and  is  used  for  the  beginning  address  of  the  IREABER 
routine.  The  variable  MAX$lNT$MEMOKT  is  set  to  the  base 
address  of  the  BDOS  and  is  used  as  the  upper  limit  for  the 
intermediate  code  file. 

2.  P*R?2.?LM 

This  program  also  has  two  variables  that  are  memory  size 
dependent,  MAXiMEMCRT  and  PASSlSTOP.  In  this  program 
MAX$MEMORY  is  set  to  the  base  address  of  the  BDOS  while 
PASS1$T0?  is  set  to  100H  bytes  below  the  base  of  the  3D0S. 

3.  IREADER.PLM 

Although,  this  program  does  not  have  ary  memory  size 
dependent  variables  the  program  must  be  modified  to  execute 
properly.  When  using  the  LOCATE  command,  under  ISIS,  this 
routine  must  be  located  100H  bytes  below  the  BDCS  of  the 
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system.  This  address  would  correspond  to  the  values  of 
MAX$MEMORY  in  PART2.PLM  and  MAX$ INTiMEMORY  in  PARTI. PLM. 

4.  INTEHP.PLM,  INTRDR.PLM,  and  BUILD. PLM 

These  three  programs  have  no  variables  that  need  to  be 
altered . 

5.  GENERAL  INFORMATION 

The  current  version  of  the  NPS  MICRO-COBOL 
compiler/interpreter  is  designed  for  continued  development 
and  certain  variables  are  not  set  to  make  optimal  use  of 
memory.  The  variable  NEXT$ AVA ILA3LE , in  PARTI. PLM,  is  set  to 
3002E  and  CODE$START,  in  INTER?. PLM,  is  set  to  3000H. 
Normally,  CODEiSTART  would  be  set  to  the  address  immediately 
following  the  last  address  in  CINTERP.COM  and  NTXT$AVAILABLE 
would  be  set  two  bytes  above  that  address.  These  address  are 
currently  set  approximately  950H  bytes  above  whe-e  they 
should  be  located,  to  allow  for  testing  and  expansion  of  the 
interpreter.  As  soon  as  implementation  is  completed  these 
two  addresses  car.  be  reset  to  appropriate  values. 
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APPENDIX  E 
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MICRO-COBOL  Parse  Table  Generation 


The  parse  tables  for  NPS  Micro-Cobol  were  generated  on 
the  IBM  360  using  the  LALR(l)  parse  table  generater 
described  in  reference  17.  There  are  basically  two  steps 
involved  in  generating  the  tables.  First,  a deck  of  cards 
containing  the  grammar  is  entered  into  the  computer  using 
the  following  JCL: 

//GO  EXEC  PGM*  L#L?.,REGION  = 220K 
//STEPLIB  DD  DSN-F0963.LALR, UNIT-2314, 
VOL=SER=LlNrA,EISP*SHR 
//SYSPRINT  DD  STSOUT-A, DCB=( RECFM=FB , 

LRECL-133 , 3LKSI ZE*3325 ) , 

//SPACS*(CTL, ( 1, 1 ) ) 

//NONTERM  DD  SPACE* (CTL , ( 1 ,1 ) ) ,UN I T-STSDA 
//FSMDATA  DD  SPACE* ( CTL , ( 1 , 1 ) ) , UN  I T*STSDA 
//PTABLES  DD  SYSOUT*B, 

DCB*(PECFM=FB,LRECL=80,3LXS IZE=300) 

//STSIN  DD  * 

The  ouput  from  this  run  is  a listing  and  a card  deck 
containing  the  tables  in  XPL  compatable  format.  This  deck  is 
then  translated  into  PLM  compatible  format  using  the 
following  JCL  and  an  XPL  orogram  which  is  available  in  the 
card  deck  library  in  the  Computer  Science  Department  at  the 
Naval  Postgraduate  School. 

//EXEC  XCOM 
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//COMP . SYS  IN  DD  * 

/ /GO .SYSPUNCH  DD  STSOUT=B, 

DC3= (RECFM=FB,LRECL=80 ,BLKS IZE=e00 ) 

/ /GO .STS IN  DD  * 

The  tables  are  then  transferred  to  a diskette  and  edited 
into  the  PLM80  source  program  using  the  ISIS  COPY  and  EDIT 
features  on  the  INTEL  MDS  System. 


t\ 

f-1 


APPENDIX  G 


LIST  OF  INOPERATIVE  CONSTRUCTS 

The  following  is  a list  of  MICRO-COEOL  elements  that 
either  have  not  been  implemented  or  have  been  implemented 
incorrectly. 

LINKAGE  SECTION 
USAGE  COMP 

{LEADING} 

SIGN  SEPARATE 

{TRAILING} 

{LEFT} 

SYNC 

{RIGHT} 

ADC 

DIVIDE 

DELETE 

EXIT 

MOVE 

MULTIPLY 

SU3TRACT 


The 

} 

following 

EYPO-COBOL  elements 

are  part 

of 

MI CR0-C03CL  only  to 

the  extent  that  they  are 

defined  in 

the 

eramnar. 

No  code  has 

been  written  to  support 

them . 

USING 

CALL 

ENTER 


VRITE  record-name 


{BEFORE } 
{AFTER}. 


ADVANCING 


{INTEGER} 

{PAGE} 


I 
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COMPUTER  LISTINGS 


PARTI: 

do; 

/*  NORMALLY  ORG'ED  AT  100H  */ 


/*  COBOL  COMPILER  - PART  1 */ 

/*  GLOBAL  DECLARATIONS  AND  LITERALS  */ 

DECLARE  LIT  LITERALLY  'LITERALLY'? 

DECLARE 


PARMS 

LIT 

'6DH  ' , 

PARMLIST (9 ) 

BYTE 

INITIALC 

EOFFILLEE 

LIT 

'1AH ' , 

/*  END  OF 

RECORD  FILLER  */ 

MAX6MEMORY 

LIT 

'0D000H ' , 
/*  TOP  OF 

USEABLE  MEMORY  */ 

I NITI AL$POS 

LIT 

'3200H ' , 

RDR$ LENGTH 

LIT 

'255', 

PASS 1$LEN 

LIT 

'48', 

CR 

LIT 

'13', 

LF 

LIT 

'i0', 

'27H  , 

QUOTE 

LIT 

POUND 

LIT 

'23H ' , 

TRUE 

LIT 

'1'. 

FALSE 

LIT 

'0 ' , 

FILE$DESC$FLAG 

BYTE 

INITIAL(FALSE) , 

REDSF$FLAG 

3YTE 

INITIAL ( FALSE ) , 

DUP£ I DEN $ ARRAY ( 24 ) 

ADDRESS 

INI TI AL( 0,0, 0,0, 0,0, 0,0, 0,0,0, 0,0, 0,0, 0,0,0, 0,0, 0.0, 0,0), 
FOREVER  LIT  'WHILE  TRUE'? 


DECLARE  MAXRNO  LIT 
MAXLNO  LIT 
MAXPNO  LIT 
MAXSNO  LIT 
STARTS  LIT 


'104',/*  MAX  READ  COUNT  */ 
'129',/*  MAX  LOOK  COUNT  */ 
'145',/*  MAX  PUSH  COUNT  */ 
'234',/*  MAX  STATE  COUNT  */ 
'1  ';/*  START  STATE  */ 


DECLARE  RSAD1  (*)  3ITE 

DATA( 0,57, 48, 56, 32, 8, 25, 59, 2, 16, 17, 22, 29, 53, 58, 11, 32, 32, 39 
,38,34,44,9,19,32,37,6,33,3,14,15,18,20,32,28,49,32,1,42 
,38,36,43,1,1,1,1,1,1,1,1 ,1 ,10,1,39,1,1,1,38,40,49,38,39,1 
,1,38,23,24,55 ,52,41  ,35,46,1,7,50,1.32,1,32,32,45 

,1 ,32,1,32,1,32,47,37,4,26,32,54,40,1 ,1 
,32,5,12 ,13,21,22,27,1,60,1,23,24, 55,30,51  )i 
DECLARE  LOOK1 ( *)  BYTE 

DATA (0,8, 0,25,0, 9, 19, 0,42, 0,42, 0,1 ,0,52,0,41,0,35,0,1,0,47 
,0,4,0,54,0,40,0,35,46,60,0,1,0,32,0,1,0,1,0,11,0,60,0,7,0 
32,0,32,0,32,0); 

DECLARE  APPLYlf*)  BYTE 

DAT A( 0,0, 0,0, 0,0, 9, 10, 12, 14, 19, 0,0, 0,0, 0,0, 101, 0,0, 100,0 
,0,0,0,0,0,97,0,27,0,0,0,69,0,91,92,0,0,91,92,0,0,0,0,13 
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,17,0,102  ,103,104,0,0,0,0,0,95,0,0,54.0,0,23,30,38,39,0 

,21,40,52,56,87,93,94,0); 

DECLARE  READ2( *)  BYTE 

DATA (0,65, 57, 64, 154, 26, 37, 67, 21, 30, 31 ,33,39,61,66,27,234 
,215,51,45,108,109,223,224,233,43,216,217,22,230,229,232 
,231,228,173  ,172 ,169, 9, 226 , 47, 196 ,1 95 ,7 , e, 1 1 , 13 , 15 ,2,3 , 105 

,14,158,4,50,20,12,18  ,48,171,170,44,49,19,10,46,35,36 

,63,60,53,42,146,16,25,58,106,155  ,148,155,155,55,150,155 

, 152 , 155 , 157 , 1 55 , 56 , 193 ,23 , 208 , 234 , 62 , 52 , 206 
,180,234  ,24,28,107,32,34,38,17,68,164,35,36,63,40,59); 
DECLARE  L00K2 (*)  BYTE 

DATA( 0,5, 130, 6. 131, 29, 29, 132, 41, 133, 54, 134, 135, 69, 71, 136 
,72,137,73,138,139,80,84,140,86,198,88,141 ,89,142184,184 
,194,91,189  ,92,93,197,211,95,143,96,97,176,99,144,145,101 

,102,200,103,202,104,188) ; 

DECLARE  APPLY2 (*)  BYTE 

DATA (0,0, 77, 11 1,112, 147, 79, 114, 81, 82, 93, 79, 76, 117, 75, 156 
,126,163,162,100,166,165,167,118,168,160,124,179,178,94 
,121,74,125  , 120, 119, 187, 187, ie6, 98, 192, 192, 191, 194, 113 

,183,128,129,127,205,205  ,205,204,115,123,90,122,214,213,221 
,219,218,222,199,85,220,116,87  ,110,70,174,209,207,182 

,182,181); 

DECLARE  INDEX1 ( * ) BYTE 

DAT A (0,1 ,2,3,4,5,6,7,8,4,4,24,4,24,4,13,14,24,109,4,15,16 
,16,24,17,18,19,16,20,22,24,25,26,28,29,34,36.37,24,24,16 
,38,39,40  ,42,43,44,45,46,47,48,49, 16,50,38,51,16,52,53,54 

,55,56,57,56,60,61  ,62,63,64,6,65,68,69,70  ,71 ,72,73,74,75,77 
, 79, 81, 83, 85, 87, e8, 89, 90, 92  ,93,94,8,8,16,95,97,97,15,103 

,104,105,109,24,24,24,1,3,5,8,10,12,14  ,16,18,20,22,24,26,28 
,30,34,36,38,40,42,44,46,48,50,52,185,149,225 
,227,227,190,151 

,153,203,159,210,161,175,212,201,177.1,2,3,3,4,4,5.5  ,6,6,12 
,13,14,14,15,15,16,16,17,19,19,20,20,20,22.22.23,23,24,24,25 
,25,26,26,27,29,29,31,32,32,33,33,35,38,38,33,33,39,39,39 
,39,39,42  ,42,43,43,44,44,45,45,48.52,52  ,53,53.54,54,55,55 

,56,56.56,56,56,56  ,56,56,58,58,58,59,59,61,61,61,61,61 

,62,67); 

DECLARE  INDEX2 (*  ) BYTE 

DATA (0,1, 1,1, 1,1  ,1,1, 5, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1,1 

,1,1, 1,1, 1,1 
,1,2, 2, 2, 2, 2, 2 
,2, 2, 3, 2, 2, 2, 2 

,2, 2, 2, 2, 2, 2, 2 ,4  ,2, 2, 2, 2, 2, 2, 2, 2 , 2, 2 ,5 ,6 ,29  ,41 , 54 ,69,71 ,72 

,73,80,84,88,89,96,99,101,3,9,3,0,3,0,3,0  ,0,1, 7, 8, 1,0, 6,0 

,0,1, 3, 0,1, 1,2, 1,0, 0,0, 0,1, 0,2, 0,0, 1,2, 0,1, 5, 3, 0,0,1  ,4,0,0 

,0,1, 2, 1,2, 2, 2, 0,2, 3, 0,3, 0,0,1, 4, 0,0, 1,0, 0,0, 0,1, 1,1, 1,2, 2,1 
,1,1, 0,0, 0,0, 0,0, 0,0,0, 0,0,0);  /*  END  CE  TABLES  */ 

DECLARE 

/*  JOINT  DECLARATIONS 

THESE  ITEMS  ARE  DECLARED  TOGETHER  IN  THIS  SECTION 
IN  ORDER  TO  PACILIT ATE  THEIR  BEING  SAVED  FOR 
THE  SECOND  PART  CP  THE  COMPILER.  */ 


OOTPUT$?CB 


(33)  BYTE 


INITIALS,  ' 

',  'CIN 

',0,0.0. 

0), 

DEBUGGING 

BYTE 

INITIAL 

(FALSE), 

PRINT$PR0D 

BYTE 

I NITIAL( FALSE  ) , 

PRINT$TOKEN 

BYTE 

INITI AL( FALSE) , 

LI ST  $ INPUT 

BYTE 

INITIAL 

(TRUE), 

SEO$NUM 

BYTE 

INITIAL 

(FALSE), 

NEXT$SYM 

ADDRESS, 

POINTER 

ADDRESS 

INITIAL 

( 100H ) , 

NEXT$AVAIL  ABLE 

ADDRESS 

INITIAL 

(3002H), 

MAX$INT$M5M 

ADDRESS 

INITIAL 

(0D100H) 

FREE$STORAGE 

ADDRESS, 

FILE$SEC$END 

BYTE 

INITIAL 

(FALSE), 

/*  I 0 BUFFERS  AND  GLOBALS  */ 
IN$ADDR  ADDRESS  INITIAL  ( 5CH  ) , 

I NPUT$FCB  BASED  INADDR  (33)  BYTE, 
OUTPUT$PTR  ADDRESS, 

OUTPUT$BUFF  (128)  BITE, 

OUTPUT$END  ADDRESS, 

OUTPUT$CHAR  BASED  OUTPUT$PTR  BYTE? 


MONl : PROCEDURE  (P,A)  EXTERNAL? 

DECLARE  A ADDRESS,  F BYTE? 

END  MONl? 

M0N2:  PROCEDURE  (F,A)  BYTE  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 

END  M0N2  ? 

BOOT:  PROCEDURE  EXTERNAL? 

DECLARE  A ADDRESS? 

END  BOOT? 

PRINTCHAR:  PROCEDURE  (CHAR)? 

DECLARE  CHAR  BYTE? 

CALL  MONl  (2, CHAR)? 

END  PRINTCHAR? 

CRLF:  PROCEDURE? 

CALL  PP.INTCHAR(CR)? 

CALL  PRINTCHAR(LF)? 

END  CRLF? 

PRINT:  PROCEDURE  (A)? 

DECLARE  A ADDRESS? 

CALL  MONl  (9, A)? 

END  PRINT? 

PR  I NT $ ERROR : PROCEDURE  (CODS)? 

/*  THIS  PROCEDURE  IS  USED  TO  PRINT  COMPILER  ERRORS  TO 
CONSOL  V 

DECLARE  CODE  ADDRESS, 


I BYTE, 


C0ES1 (6 ) address; 

IF  CODE  * FALSE  THEN 

do; 

DO  I = 0 TO  5J 
CODEl(I)  * 0; 

END; 

I = 0J 

end; 

ELSE 

IF  CODE  = TRUE  THEN 

do; 

1 = 0; 

DO  VHI LE ( ( I <>  6)  AND  ( CODEl(I)  <>  0)); 

CALL  crlf; 

CALL  PRINTCFAR(HIGH(CODEl( I ) ) ) ; 

CALL  PRINTCHAR( LOW  (CODEl(I))); 

CODE1  ( I ) * 0; 

I*I+i; 

end; 

I * 0; 

end; 

ELSE 

IF  (CODE  * 'N?')  OR  (CODE  = 'SL')  OR  (CODE  = 'NV')  THEN 

do; 

CALL  crlf; 

CALL  PRINTCHAR(  HIGH(  CODE) ) ; 

CALL  PRINTCHAR( LOW ( CODE)  ) J 

end; 

ELSE 

do; 

IF  I <>  6 THEN 

do; 

CODEl(I)  * code; 

1=1+1; 

end; 

end; 

end  printserror; 

FATALiERROR:  PROCEDURE( REASON  ) ; 

DECLARE  REASON  ADDRESS; 

CALL  PRINT$E3R0R(REAS0N  ); 

CALL  PR I NT TERROR (TRUE ) ; 

CALL  TIME(10); 

CALL  300T; 

end  fatal$error; 

OPEN:  procedure; 


IF  M0N2  (15, IN$ADDR )=255  THEN  CALL  FATAL$ERROR( 'OP' ) J 
END  open; 


IF  (DCNT:=MON2(20,.IN?UT$FC1))>1 
THEN  CALL  FATAL$ERROR( 'BR ' ) J 
RETURN  NOT  (DCNT) * 

END  moresinput; 


MAKE:  PROCEDURE? 

/*  DELETES  ANT  EXISTING  COPT  OF  THE  OUTPUT  FILE 
AND  CREATES  A NEW  COPT*/ 

CALL  MON1 ( 19 , . OUTPUTS FCB ) » 

IT  M0N2 ( 22 , . OUTPUTS FCB )=255  THEN  CALL  FATAL$ERROR( 'MA' ) * 
END  make; 

WP.ITE$OUTPUT:  PROCEDURE? 

/*  WRITES  OUT  A BUFFER  V 

CALL  MON1 ( 26 , .OUTPUT$BUFF ) J /*  SET  DMA  */ 

IF  M0N2(21 ,.OUTPUT$FCB)O0  THEN  CALL  FATAL$ERROR(  'WR ' ) ; 
CALL  MONK26.80H);  /*  RESET  DMA  */ 

END  writesoutput; 

MOTS:  PROCEDURE( SOURCE,  DESTINATION,  COUNT)? 

/*  MOVES  FOR  THE  NUMBER  OF  BTTES  SPECIFIED  BT  COUNT  */ 
DECLARE  (SOURCE, DESTINATION)  ADDRESS, 

(SSBYTF  BASED  SOURCE,  D$BTTE  BASED  DESTINATION,  COUNT) 

byte; 

DO  WHILE  (COUNT:=COUNT  - 1)  <>  255? 

d$btti=s$btte; 

SOURCE*SOURCE  +1? 

DESTINATION  = DESTINATION  + 1? 

end; 

END  MOVE? 


FILL:  PROCEDURE ( ADDR .CHAR , COUNT  ) ? 

/*  MOVES  CHAR  INTO  ADDR  FOR  COUNT  BTTES  */ 
DECLARE  ADDR  ADDRESS, 

(CHAR, COUNT, TEST  BASED  ADDR)  BYTE? 

DO  WHILE  ( COUNT : “COUNT  -1)0255; 

dest=char; 

ADDR=*ADDR  ♦ 1? 

END? 

END  FILL? 


/*  * * 

DECLARE 

* * * 

SCANNER  LITS  * * * 

LITERAL 

LIT 

'15', 

TNPUTSSTR 

LIT 

'32', 

PERIOD 

LIT 

'1', 

INVALID 

LIT 

'0'; 

/*  * * * 

* SCANNER 

TABLES  * * * * */ 

DECLARE  TOKEN$ TABLE  (*) 

BYTE  DATA 

*/ 


/*  CONTAINS  THE  TOKEN  NUMBER  ONE  LESS  THAN  THE 
FIRST  RESERVED  WORD  FOR  EACH  LENGTH  OF  WORD  */ 
( 0 , 0 , 1 ,4 , 5 , 15 ,22  ,32 ,38 ,44 ,47 ,49 ,51 ,55 , 56, 57) , 
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TABLE  (*)  BYTE  DATA( 'FD', 'OF', 'TO', 'PIC', 'COMP', 'DATA', 'FILE' 
, 'LEFT' , 'MODE ' , 'SAME ',  'SIGN  ',  'SYNC  ' , 'ZERO ' , 'BLOCK  ' , 'LABEL  ' 

, 'QUOTE' , 'FIGHT', 'SPACE', 'USAGE' , 'VALUE ', 'ACCESS ' , 'ASSIGN' 

, 'AUTHOR',  'FILLER '.'OCCURS', 'RANDOM', 'RECORD', 'SELECT' 
.'DISPLAY' , 'LEADING', 'LINKAGE', 'OMITTED'  .'RECORDS  ' 

, 'SECTION', 'DI VISION ', 'RELATIVE' , 'SECURITY', 'SEPARATE' 

, 'STANDARD', 'TRAILING', 'DEBUGGING ', 'PROCEDURE' , 'REDEFINES ' 

, 'PROGRAM-ID' , 'SEQUENTI AL' , 'ENVIRONMENT  ' , ' I-O-CONTROL ' 

, 'DATE-WRITTEN ', 'FILE-CONTROL', 'INPUT-OUTPUT', 'ORGANIZATION  ' 

, 'CONFIGURATION', 'IDENTIFICATION  ', 'OBJECT-COMPUTER' 

, 'SOURCE-COMPUTER  ', 'WORKING-STORAGE')  , 

OFFSET  (16)  ADDRESS 

/*  NUMBER  OF  BYTES  TO  INDEX  INTO  THE  TABLE 
FOR  EACH  LENGTH  */ 

INITIAL  (0,0,0,6,9,45,80,128,170,218,245,265, 
287,335,348,362) , 

WORDi COUNT  (*)  BYTE  DATA 

/*  NUMBER  OF  WORDS  OF  EACH  SIZE  */ 

( 0,0, 3,1 ,9, 7,8, 6, 6, 3, 2, 2, 4,1 ,1,3)  , 


MAX$LEN 

LIT 

'16'. 

ADD$END (*) 

BYTE  DATA 

('PROCEDURE  '), 

LOOKED 

BYTE 

INITIAL  (0), 

HOLD 

BYTE, 

BUFFERS  END 

ADDRESS 

INITIAL  ( 100H  ) , 

NEXT 

BASED 

POINTER  BYTE, 

INBUFF 

LIT 

'80H ' , 

CHAR 

BYTE, 

ACCUM$LENG 

LIT 

'50', 

A CCUM$LEN$  P£l  LIT 

'51'. 

/*  = TO  ACCUMiLENG  PLUS 

1 */ 

ACCUM  (ACCUM$LEN$P$1)  BYTE, 

DISPLAY ( 74  ) 

BYTE 

INITIAL  (0), 

TOKEN 

BYTE, 

/♦RETURNED  FROM 

EDITSFLAG 

BYTE 

INITIAL(FALSE) J 

/**«** 

PROCEDURES 

USED  BY  THE  SCANNER  * 

* * */ 


NEXT$CHAR:  PROCEDURE  BYTE • 

IF  LOOKED  THEN 

do; 

looked=false; 

RETURN  (CHAR:*HOLD); 

end; 

IF  (POINTER : =POI NTER  + 1 ) >■  3UFFER$SND  THEN 

do; 

IF  NOT  MORE$ INPUT  THEN 

do; 

buffer$end=. memory; 

POINTER*. ADD$END; 

end; 
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else  ?ointer=inbuff; 

end; 

IF  NEXT  = EOFFILLER  THEN 

do; 

BUFFER $END  » .MEMORY? 

POINTER  = .ADD$END? 

end; 

RETURN  (CHAR:=NEXT) ? 

END  N EXT  $ CHAR? 

GET$CEAR : PROCEDURE? 

/*  THIS  PROCEDURE  IS  CALLED  WHEN  A NEW  CHAR  IS 
NEEDED  WITHOUT  THE  DIRECT  RETURN  OF  THE  CHARACTER*/ 

char=next$char; 
end  get$cear; 

DISPLAY$LINE:  PROCEDURE? 

DECLARE  I BYTE? 

IF  NOT  LISTt INPUT  THEN  RETURN; 

IF  NOT  ED I T$ FLAG  THEN 

do; 

DISPLAY ( DIS PL AY( 0 ) + 1)  = 

CALL  PR  I NT ( .DISPLAY (1  ) } ? 

end; 

ELSE  DO  I = 1 TO  DISPLAYS); 

CALL  PRINTCHAR( DISPLAY ( I ) ) ? 

end; 

DISPLAY ( 0 ) = 0? 

EDIT$FLAG  = FALSE? 

END  DISPLAY$LINE? 

LOADiDISPLAY:  PROCEDURE? 

IF  DISPLAY (0 ) < 72  THEN 

DISPLAY (DISPLAY ( 0 ) : = DIS  PLAY ( 0 ) + 1)  = CHAR? 

IF  CHAR  = '$'  THEN  EDIT$FLAG  = TRUE? 

CALL  GETSCHAR? 

END  LOADSDISPLAY? 

PUT:  PROCEDURE? 

IF  ACCUM( 0 ) < ACCUM$LENG  THEN 
ACCUM(ACCUM(0 ) :*ACCUM (0 )+l )=CHAR? 

call  load$display; 

END  put; 

EAT$LINE:  procedure; 

DO  WHILE  CHAROCRJ 

call  loadsdisplay; 

end; 

end  eat$line; 

GET$NO$BLANX : PROCEDURE? 

DECLARE  (N.l)  BYTE? 

DO  FOREVER? 

IF  CHAR  = ' ' THEN  CALL  LOAD$DIS?LAYj 
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ELSE 


IT  CHAP=CR  THEN 

do; 

CALL  DISPLAYiLlNEJ 
CALL  PRINT$ERROR(TRUE); 

IF  SEQ$NUM  THEN  N=8J  ELSE  N*2; 

DO  I = 1 TO  NJ 

CALL  LOAD$DISPLAYJ 

end; 

IF  CHAR  * THEN  CALL  EAT$LINE; 

ELSE 

IF  CHAR  = THEN 

do; 

IF  NOT  DEBUGGING  TEEN  CALL  EATALINE 
ELSE  CALL  LOAD$DISPLAY; 

end; 

end; 

ELSE 

return; 


end;  /*  END  OF  DO  FOREVER  */ 
END  GET$NOiPLANE; 


SPACE:  PROCEDURE  BYTE; 

RETURN  ( CHAR* ' ')  OR  (CHAR=CR)J 
END  space; 


DELIMITER:  PROCEDURE  BYTE? 

/*  CHECKS  FOR  A PERIOD  FOLLOWED  BY  A SPACE  OR  CR*/ 
IT  CHAR  <>  THEN  RETURN  FALSE; 

hold=next$char; 

looked=true; 

IF  SPACE  THEN 

dc; 

CHAR  = 

return  true; 

end; 

char*'.  '; 
return  false; 
end  delimiter; 

IND$OF$TOKEN  : PROCEDURE  BYTE? 

RETURN  SPACE  OR  DELIMITER; 

end  end$of$tcken; 

GETSLITERAL:  PROCEDURE  BYTE; 

CALL  loadadisplay; 
do  forever; 

IF  CHAR*  QUOTE  THEN 

do; 

CALL  LOADiDISPLAYJ 
RETURN  LITERAL; 

end; 

call  put; 


end; 


END  get*literal; 


LOOK$UP:  PROCEDURE  BYTE; 

DECLARE  POINT  ADDRESS, 

HERE  BASED  POINT  (1)  BYTE, 

I byte; 

MATCH:  PROCEDURE  BYTE? 

DECLARE  J BYTE? 

DO  J*1  TO  ACCUM(0); 

IF  HERE(J  -1)0  ACCUM(J)  THEN  RETURN  FALSE? 

end; 

RETURN  TRUE? 

end  match; 

POINT=OFFSET( ACCUM( 0) )+  .TABLE? 

DC  1*1  TO  WORD$COUNT( AC CUM ( 0 ) ) ; 

IF  MATCH  THEN  RETURN  I? 

POINT  * POINT  + ACCUMI0); 

end; 

RETURN  FALSE? 

end  lookup; 


RES ERVED$WORD : PROCEDURE  BYTE? 

/*  RETURNS  THE  TOKEN  NUMBER  OF  A RESERVED  WORD  IF  THE 
CONTENTS  OF  TEE  ACCUMULATOR  IS  A RESERVED  WORD,  OTHERWISE 
RETURNS  ZERO  */ 

DECLARE  VALUE  BYTE? 

DECLARE  NUMB  BYTE? 

IF  AC  CUM  ( 0 ) > MAXUEN  THEN  RETURN  0? 

IF  (NUM3:=TOKEN$TABLS(ACCUM(0) ) )*0  THEN  RETURN  0? 

IF  ( VALUE:=LOOK$U?)=0  THEN  RETURN  0? 

RETURN  (NUMB  + VALUE) ? 


END  RSSE?.V£D$WCRP; 

G2TST0KEN:  PROCEDURE  BYTE? 

ACCUM(0)=0? 

CALL  GET$NC$3LANK; 

IF  CHAR=QUCTS  THEN  RETURN  GETALITERAL? 

IF  DELIMITER  THEN 
DO? 

CALL  PUT? 

RETURN  PERIOD? 

end; 

do  forever; 

CALL  PUT  * 

I7-END$0F$T0KEN  THEN  RETURN  INPUT$STR? 
END?  /*  OF  DO  FOREVER  */ 

END  GET$TOKENJ 


SCANNER:  PROCEDURE; 

DECLARE  CHECK  BYTE? 

DO  forever; 

IF ( TOKEN :*GET$ TOKEN ) 


INPUT$STR  THEN 


mm i 


* 


IF  (CHECK :=RESERVEDSWORD)  <>  0 THEN  TOKEN-CHECK? 
IF  TOKEN  <>  0 THEN  RETURN? 

CALL  PRINT$ERROR  ( 'SE')  ? 

DO  WHILE  NOT  END$OF$TOKEN ? 

CALL  GET$CHAR? 

END? 

END? 

END  SCANNER? 

PRINT$ACCUM:  PROCEDURE? 

ACCUM(ACCUM{0)+1  )*'$'? 

CALL  PR  I NT ( . ACCUM( 1 ) ) ? 

END  PRINT$ACCUM? 

PRINTSNUMBER:  PROCEDURE ( NUMB ) ? 

DECLARE(NUMB,I ,CNT,K)  BYTE,  J(*)  BYTE  DATA ( 100, 10 ) ? 

DO  1=0  TO  1? 

CNT*0 ; 

DO  WHILE  NUMB  >=  (K:=J( I) ) ? 

NUMB-NUMB  - K? 

CNT-CNT  1? 

END? 

CALL  PP.I  NTCHAR  ( '0  ' ♦ CNT ) ? 

END? 

CALL  PR  I NT CHAR  ( '0 ' + NUMB)? 

END  PR  I NT$ NUMBER? 

IN ITSSCANNER : PROCEDURE? 

/♦  INITIALIZE  FOR  INPUT  - OUTPUT  OPERATIONS  */ 
DECLARE  CONSCBL  (*)  BYTE  DATA  ( 'CBL ' ) , 

I BYTE, 

TESTFLAG  BYTE? 

CALL  MOVE ( FARMS , .PARMLI ST  ,8 ) ? 

IF  ?A3MLIST( 0 ) * '$'  THEN 
DO? 

1*0? 

DC  WHILE  ( TESTFLAG : -PARMLI ST ( I :=I+1 ) ) <>  ' '? 

IF  TESTFLAG  - 'L ' THEN  LISTS INPUT-NOT  LIST$IN?UT? 

IF  TESTFLAG  = 'S'  THEN  SSQSNUM-  NOT  SEOSNUM? 

IF  TESTFLAG  * 'P'  THEN  PRINTSPRCD  - NOT  PRINTSPROD? 

IF  TESTFLAG  » 'T ' THEN  PP.INT$T0KEN  * NOT  PPINTSTOKEN 
END? 

END? 

CALL  MOVE  (.CONSCBL.  INSADDR  + 9,  3)? 

CALL  PILL(  INSADDR  12,0,5)? 

CALL  OPEN? 

CALL  MOVE( INADDR, .OUTPUTSFCB ,9 ) ? 

OUTPUTrFCB ( 32 ) - 0? 

0UTPUTiEND-(0UTPUT$PTR:=.CUTPUTS3UFF  - 1)  + 128? 

CALL  MAKE? 

CALL  GETSCHAR?  /*  PRIME  THE  SCANNER  */ 

IF  SEQSNUM  THEN 
DO  I - 1 TO  6? 

CALL  LOADSDISPLAT? 
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2ND? 

IP  CHAR  = '*'  THEN  CALL  EAT$LI NE» 

CALL  GET$NO$BLANK? 

CALL  PP.  I NT iERROR  ( PALS  E ) J /*  INITIALIZES  ERROR 

MSG  OUTPUT  */ 

END  init$scanner; 

/*  * * * END  OF  SCANNER  PROCEDURES  * * * */ 


/*  * * 

* * 

SYMBOL  TABLE 

DECLARATIONS  * * * */ 

DECLARE 

CUR$S YM 

ADDRESS, 

/♦SYMBOL  BEING  ACCESSED*/ 

SYMBOL 

BASED  CUR$SYM 

( 1 ) BYTE  . 

SYMBOL$ADDR 

BASED  CUR$SYM 

(1)  ADDRESS, 

NEXT$  SYM$ENTRY 

BASED  NEXT$S YM 

ADDRESS, 

HASH$PTR 

S AVE$  ADDR 
DISPLACEMENT 

ADDRESS, 

ADDRESS, 

LIT 

'13'. 

HASH$MASK 

LIT 

'3FH ' , 

StTYPE 

LIT 

'2', 

OCCURS 

LIT 

'12', 

ADDR2 

LIT 

'4'. 

PiLENGTB 

LIT 

'3'. 

SSLSNGTH 

LIT 

'3', 

LEYEL 

LIT 

'10', 

DECIMAL 

LIT 

'11'. 

LOCATION 

LIT 

'2'. 

REL$ ID 

LIT 

'5', 

STARTSNAME 

LIT 

'12'.  /*1  LESS*/ 

MAX$ID$LEN 

LIT 

'12'; 

/*  * * 

* * 

TYPE  LITERALS 

*****«#*/ 

DECLARE 

SEQUENTIAL 

LIT 

'i:. 

SEQ^RELATIVE 

LIT 

'2', 

RANDOM 

LIT 

'3'. 

VARIABLE$LENG 

LIT 

GROUP 

LIT 

6 , 

COMP 

LIT 

'21'; 

/*  * * * SYMBOL  TABLE  ROUTINES  * * * */ 


IN IT$SYMBOL:  PROCEDURE; 

/*  INITIALIZE  HASH  TABLE  AND  FIRST  COLLISION  FIELD  */ 
FREE$STORAGE  * .MEMORY; 

CALL  FILL  iFREE^STORAGS, 0,130); 
NEXTtSYM*?RSE$ST0RAGE«-128; 

NEXT$SYMSENTRY*0; 

END  iNlTiSYMBOLJ 


3ET$PUBNGTH:  PROCEDURE  BYTE; 
RETURN  SYMBOL  ( P$  LENGTH ) ; 


END  getspSlength; 


SET$ADDRESS  : PROCEDURE ( ADDR  ) ? 
DECLARE  ADDR  ADDRESS ? 

S YMBOL$ ADDR ( LOCATION )=ADDRJ 
END  SETSADDRESS? 

GET$ADDRESS : PROCEDURE  ADDRESS. 

RETURN  SYMBOL$ADDR( LOCATION ) ; 
END  GETS ADDRESS. 


GETSTYPE:  PROCEDURE  BYTE; 

RETURN  SYMBOL(SSTYPE) ? 
END  GETS  TYPE? 

SETSTYPE:  PROCEDURE( TYPE) ; 
DECLARE  TYPE  BYTE? 

symbol(s$ty?e)=type; 

END  SETSTYPE? 


ORSTYPE:  procedure(type); 

DECLARE  TYPE  BYTE? 
SYMBOL(SSTYPE)=TYPE  OR  getstype; 
END  ORSTYPE; 

GETSLEVEL:  PROCEDURE  BYTE; 

RETURN  SYMBOL* LEVEL  )? 

END  GETSLEVEL; 

SETSLEVEL:  PROCEDURE  (LVL)J 
DECLARE  LVL  BYTE,* 

symbol(levsl)=lvl; 

END  SETSLEVEL? 

GETSDECIMAL:  PROCEDURE  BYTE; 

RETURN  SYMBOL (DECIMAL ) J 
END  GETSDECIMAL? 

SETSDECIMAL:  PROCEDURE  (DEC); 

DECLARE  DEC  BYTE; 

SYMBOL( DEC IMAL)=DEC  J 
END  SETSDECIMAL; 

SETSSSLENGT3:  PROCEDURE(HO¥$LONG ) ; 
DECLARE  HOWSLONG  ADDRESS? 

symbolSaddr(sslength)  = howslong; 

END  SETSSSLENGTH; 

GETSSSL2NGTH:  PROCEDURE  ADDRESS? 

RETURN  SYMBOLSADDR(SSLENGTH) J 
END  getssslength; 

SETSADDR2:  PROCEDURE  (ADDR); 

DECLARE  ADDR  ADDRESS? 
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SYMBOL$ADDR ( ADDR2 ) =ADDR ; 

END  SET$ ADDR2? 

GET$ADDR2:  PROCEDORE  ADDRESS? 

RETURN  SYMBOL$ADDR( ADDR2)? 
END  GET$ ADDR2 ? 

SET$OCCURS:  PRCCEDURE(OCCUR) ? 
DECLARE  OCCUR  BYTE? 

SYMBOL* OCCURS  )=OCCUR? 

END  SET$ OCCURS  ? 

GET$OCCURS:  PROCEDURE  BYTE? 

RETURN  SYMBOL  (OCCURS)? 

END  GST$OCCURS? 

SET$IO$ADDRS : PROCEDURE? 


SYMBOL$ADDR ( LOCATION ) * NEXTASYM? 
SAVESADDR  = CUR$SYM? 

END  SET$ 10$ ADDRS  * 


/*  * * * 

PARSER 

DECLARATIONS  * * * */ 

DECLARE 

INT 

LIT 

'63',  /*  CODE  FOR  INITIALIZE  */ 

SCD 

LIT 

'66',  /*  CODE  FOR  SET  CODE  START 

PSTACKSIZE 

LIT 

'30',  /*  SIZE  OF  PARSE  STACKS*/ 

STATESTACK 

(PSTACKSIZE)  BYTE,  /*  SAVED  STATES  */ 

VALUE 

(PSTACKSIZE)  ADDRESS,  /*  TEMP  VALUES  */ 

VARC 

(51) 

BYTE,  /*TEMP  CHAR  STORE*/ 

ID$STACK 

(10) 

ADDRESS  INITIAL  (0), 

ID$STACK  $PTR 

BYTE 

INITIALS)  , 

HOLD$LIT  ( ACCUM$LEN$P$1  ) 

BYTE, 

HOLD$SYM 

ADDRESS, 

PENDI NG$ LITERAL 

BYTE 

INITIAL( FALSE)  , 

PENBI NG$LIT$ ID 

ADDRESS, 

REDE7 

BYTE 

INITIAL  (FALSE), 

REDEF$ONE 

ADDRESS, 

RZDEF$T¥0 

ADDRESS , 

TEMP$HOLD 

ADDRESS, 

TEMP$T¥0 

ADDRESS, 

COMPILING 

BYTE 

INITIAL(TRUE)  , 

SP 

BYTE 

INITIAL  (255), 

MP 

BYTE, 

MPP1 

BYTE, 

NOLOOK 

BYTE 

INITIAL(TRUE) , 

(I.J.K) 

BYTE, 

/*I NDI CIES  FOR  THE  PARSER*/ 
INITIAL' STARTS  ) , 

STATE 

BYTE 

7ALUEAFLAG 

BYTE 

INI?IAL( FALSE ) , 

VALUE$LEVEL 

BYTE 

INITIALS), 

TRUNC$FLAG 

BYTE 

INITIAL (TRUE ) ? 

/*  * * * 

PARSER 

ROUTINES  *♦***/ 

3YTE$0UT : PROCEDURE(ONE$BYTE) ? 

/*  THIS  PROCEDURE  WRITES  ONE  BYTE  OP  OUTPUT  ONTO  THE  DISH 


IF  REQUIRED  THE  OUTPUT  BUFFER  IS  DUMPED  TO  THE  DISK  */ 
DECLARE  ONESBYTE  BYTE; 

IF  ( OUTPUT $PTR :*OUTPUT$PTR  + 1)>  OUTPUT$END  THEN 

do; 

CALL  WRITE$OUTPUT; 

OUTPUT$PTR- .output$buff; 

end; 

output$char=one$byte; 

END  BYTEiOUT; 

STRlNG$OUT:  PROCEDURE  (addr, count) ; 

DECLARE  (ADDR. I, COUNT)  ADDRESS,  (CHAR  BASED  ADDR)  BYTE? 
DO  1*1  TO  count; 

CALL  BYTE$OUT(CHAR); 

ADDR=ADDR+i; 

END; 

END  STRlNGiOUTI 

ADDR$OUT : PROCEDURE( ADDR) J 
DECLARE  ADDR  ADDRESS; 

CALL  BYTE$OUT ^ LOW (ADDR  ))  J 
CALL  BYTE$OUT ( 3IGH( ADDR  ) ) ; 

END  addr$out; 

FI LL$ STRING:  PROCEDURE! COUNT, CHAR) J 

DECLARE  (I, COUNT)  ADDRESS,  CHAR  BYTE; 

DO  1=1  TO  COUNT; 

CALL  BYTEiOUT ( CHAR  ) ; 

end; 

end  fill$string; 

START$ INITIALIZE : PROCEDURE (ADDR ,CNT ) ; 

DECLARE  (ADDR.CNT)  ADDRESS? 

CALL  BYTEOUT(INT); 

CALL  ADDRiOUT (ADDR) J 
CALL  ADD°$OUT( CNT ) ? 

END  start$initialize; 

3UILD$SYM3CL  : PROCEDURE (LEN  ) J 

DECLARE  LEN  BYTE,  TEMP  ADDRESS? 

temp=next$sym; 

IF  ( NEXTiSYM : = .SYMBOL ( LEN : =LEN+DI SPLACEMENT ) ) 

> MAX$MEMORY  THEN  CALL  FATAL$ERROR(  'ST ' ) J 
CALL  FILL  (TEMP, 0, LEN); 

END  build$symbcl; 

DUP$IDEN$TEST:  PROCEDURE? 

DECLARE  I BYTE? 

IF  REDEF^FLAG  THEN 
DO? 

RED EFSFLAG  * FALSE; 

return; 

end; 


ELSE 

IF  FI LE$DESC$FLAG  THEN 
DO? 

FILE$DESC$FLAG  = FALSE? 

1=0; 

DO  WHILE  DUP$ IDEN$ARRAY ( I ) <>  0? 

IF  DUPSIDEN$ARRAY( I)  = CUR$SYM  THEN 

do; 

CALL  PR  I NTS  ERROR ( "DI " )? 

return; 

end; 

i = i + i; 

IF  I > 23  THEN 

do; 

CALL  PRlNT$ERROR(  "EF" ) J 

return; 

end; 

end; 

DUP$IDEN$  ARRAY ( I ) = CURSYM? 
return; 

end; 

ELSE 

CALL  PRINTSERROR ( 'DI ' ) J 

end  dupsidenstest; 

MATCH:  PROCEDURE  ADDRESS? 

/*  CHECKS  AN  IDENTIFIER  TO  SEE  IF  IT  IS  IN  THE  SYMBOL 
TABLE.  IF  IT  IS  PRESENT,  CURSSYM  IS  SET  FOR  ACCESS. 
OTHERWISE  A NEW  ENTRY  IS  MADE  AND  THE  PRINT  NAME 
IS  ENTERED.  ALL  NAMES  ARE  TRUNCATED  TO  MAXSIDSLEN*/ 
DECLARE  POINT  ADDRESS, 

COLLISION  BASED  POINT  ADDRESS, 

(HOLD, I)  byte; 

IF  VARC(0)>MAX$ID$LEN 

THEN  7 A F. C ( 0 ) = MAX$IDSLEN; 

/*  TRUNCATE  IF  REQUIRED  */ 

HCLD  = 0? 

DO  1=1  TO  VA P.C < 0 ) J /*  CALCULATE  HASH  CODE  */ 
HOLD=HOLD  + VARC(I  )J 

end; 

POINT=FRSESSTORAGE  + SHL( ( HOLD  AND  HAS HSMASK ) , 1 ) ? 

DO  forever; 

IF  COLLIS ION=0  THEN 
DO? 

IF  FILESDESCSFLAG  THEN 

do; 

FILESDESCSFLAG  * FALSE; 

CALL  PRINT$ERROR ( 'UI  ' ) ; 

end; 

ELSE 

IF  REDEF$ FLAG  THEN 

do; 

REDEF$FLAG  = FALSE? 

CALL  PRINT$ERROR(  "UI  ' ) ? 
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end; 

cur$sym,collision=next$sym; 

CALL  BUILD$SYMBOL( VARC ( 0 ) ) ? 

/*  LOAD  PRINT  NAME  */ 

SYMBOL ( P$ LENGTH  ) = VARC ( 0 ) ; 

DO  I = 1 TO  VARC(0); 

SYMBOL (STARTSNAME  + I )=VARC ( I ) ? 

end; 

RETURN  CUR$SYMJ 

end; 

ELSE 

do; 

cur$sym=collision; 

IP  ( HOLD : =GET $P$LENGTH )=V ARC (0)  THEN 

do; 

1=1 ; 

DO  WHILE  SYMBOL(START$NAME  + I)*  VARC( I ) 
IF  (I  : = I+1 ) >HOLD  THEN 

do; 

CALL  DUP$IDEN$TEST; 

RETURN  ( CUR$SYM:=COLLISION) ; 

end; 

end; 

end; 

end; 

point=collision; 

end; 

end  match; 

ALLOCATE:  PROCEDURE( BYTES  $REQ ) ADDRESS? 

/*  THIS  ROUTINE  CONTROLS  THE  ALLOCATION  OF  SPACE 
IN  THE  MEMORY  OF  THE  INTERPRETER.  */ 

DECLARE  ( HOLD ,BYTES$REQ  ) ADDRESS? 

hold=next$available; 

IF  ( NEXT$AVA I LABLE:=NEXT$ AVAILABLE  + 3YTSS$REQ) 
>MAX$INT$MEM 

THEN  CALL  FATAL$ ERROR ( 'MO  ' ) ? 

RETURN  HOLD? 

END  ALLOCATE? 

DIGIT:  PROCEDURE  (CHAR)  BYTE? 

DECLARE  CHAR  BYTE? 

RETURN  (CHAR  <*  '9')  AND  (CHAR  >-  '0')? 

END  digit; 

SET$REDFF:  PROCEDURE ( OLD, NEW ) J 
DECLARE  (OLD, NEW)  ADDRESS? 

p.edef$one*old; 

REDEF$TWG=NEW? 

redef*true; 

END  set$redef; 

SET$CUR*SYM:  PROCEDURE? 


CUR$STM=IDiSTACK(  ID$STACK$PTR ) ? 

END  set$cur$sym? 

STACK$LEVEL : PROCEDURE  BYTE? 

CALL  SET$CUP$SYM? 

RETURN  GET$LEVEL? 

END  STACIUEVELJ 

LOAD$LEVSL:  PROCEDURE? 

DECLARE  HOLD  ADDRESS? 

LOAD$REDE?$ADDR:  PROCEDURE? 

CUR$SYM=REDEF$ONE? 

HOLD*GET$ ADDRESS  ? 

END  LOAD$REDEF$ADDR; 

IP  I D$STACK ( 0 ) <>  0 THEN 
DO? 

IF  VALUE (SP-2)»0  THEN 
DO? 

CALL  SET$CUR$SYM? 

30 LD=GET$S$ LENGTH  ♦ GETS  ADDRESS ? 

END? 

ELSE  DO? 

IF  FILE$SEC$END  THEN 
DO? 

IF  ID$STACK( ID$STACE$PTR)  <>  REDEF$ONE 
THEN 
DO? 

CALL  PPINT$ERR0R( 'Hi')? 
REDEF$ONE*ID$STACK( ID$STACK$?TR) ? 
END? 

END? 

CALL  load$redef$addr; 

END? 

IF  ( IDSSTACK$PTR:=ID$STACI$PTR+1)>9  THEN 
DO? 

CALL  PRINT$ERR0R(  'EL')? 

ID$STACK$PTR=9; 

end; 

END? 

ELSE  hold=next$a*ailabls; 

IDSSTACK' ID$STACK$PTR)=VALUE(MPP1 )? 

CALL  SET$CUP$SYM? 

IF  (GETSLEVFL  * 1)  AND  (NOT  FILE$SEC$END ) THEN 
CALL  SET$ADDR2(SAVE$ADDR); 

CALL  SET$ADDRESS (HOLD) ? 

END  LOADSLEVEL J 

REDEFSORSVALUE:  PROCEDURE; 

DECLARE  HOLD  ADDRESS, 

(DEC, K,J, SIGN, CHAR)  BYTE? 

IF  REDEF  THEN 
DO? 


IF  REDEF$TVO=CUfi$SYM  THEN 

do; 

hold»get$s$length; 

cur$sym=redef$one; 

IF  BOLD>GET$S$LENGTH  THEN 

do; 

CALL  PRINT$ERR0RI 'R2'); 

hold=get$s$length; 

CUR$SYM*REDEF$TWO; 

CALL  SET$S$LENGTH(HOLD); 

end; 

end; 

end; 

ELSE  IF  PENDI NG$ LITER AL=0  THEN  RETURN; 

IF  ( PENDI  NG$LIT$IDOI  D$STACK$PTR ) OR  VALUE$FLAG 
THEN  RETURN? 

IF  PENDING$LITERAL  <>  0 THEN 
CALL  START$INITIALIZE( GET$ ADDRESS .HOLD :=GET$ S$ LENGTH ) J 
IF  PENDING$LITERAL>2  THEN 

do; 

IF  PENDI  NGUITERAL=3  TEEN  CEAR»'0'j 
ELSE  IF  PEN DINGiL ITER AL=4  THEN  CHAR=  ' '; 

ELSE  IF  PENDING$LITERAL  ■ 5 THEN  CHAR  = QUOTE; 

CALL  FILL$STRlNG(HOLD, CHAR) J 
end; 

ELSE  IF  PENDING^ LITERAL  = 2 TEEN 
DO; 

IF  HOLD  <=  HOLD$LIT (0 ) THEN 

CALL  STRI NG$OUT ( .HOLD$LIT( 1 ) .HOLD) ; 

ELSE  do; 

CALL  STRING $OUT( .HOLDiLIT ( 1 ) ,HOLD$LIT ( 0)  ); 
CALL  FILL$STRING (HOLD  - HOLD$LIT ( 0 ) , ' '); 
END; 

end; 

ELSE  IF  PENDING$LITERAL=1  THEN 

do; 

/*  THE  NUMBER  HANDELER  */ 

DECLARE  (DEC,MINUS$SIGN , I f J ,LIT$DEC ,N$LENGTH, 
NUM$BEFORE.NUM$ AFTER,  TYPE)  BYTE, 

ZONE  LIT  '10H'; 

IF( (TYPE:=GET$TYPE)<16)  OR  ( TYPE>21 ) THEN 
CALL  PRINT$ ERROR ( 'NV'); 

n$length*get$s$length; 
dec*gst$decimal; 
minus $sign*false; 

IF  HOLDHlTd)  = THEN 
do; 

minus$sign=true; 

j=i; 

end; 

ELSE  IF  HOLD$LIT(l)  =*  THEN  J-i; 

ELSE  J*0J 
LIT$DEC=0; 
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DO  1=1  TO  HOLD $L IT (0)  J 

IF  HOLD$LIT(I )='.'  THIN  LIT$DEC*i; 

snd; 

IT  EOLD$LIT ( 0)  <>  0 THEN 
DC? 

IF  LIT$DSC=0  THEN 

do; 

NUN$BEFORE*HOLD$LIT(0)-J; 

NUM$AFTER =0? 

end; 

ELSE  do; 

NUM$BEFORE=LITiDEC  -J-l! 
NUM$AFTER*HOLD$LIT(0)  - LITSDECJ 

end; 

end; 

ELSE  IF  30LD$L IT ( 0 ) = 0 THEN 

do; 

num$before  = 0; 

NUM$ AFTER  = 0; 

LIT$DEC  = 0; 

end; 

IF  ( I :=N$LENGTH  - DEC )<NUM$BEFORE  THEN 
CALL  PRINTS ERROR ( 'SL ' ) ; 

IF  I>NDM$BEFORE  THEN 

do; 

i=i-num$before; 

IF  MINUS$S IGN  THEN 

do; 

1*1-1; 

CALL  BTTE$OUT ( '0  ' + ZONE); 

end; 

CALL  FILL$STRING(I,'0'); 

end; 

ELSE  IF  MINUS$SIGN  THEN  HOLDSLIT ( J+l ) 

=holdslit(j+i)+zone; 

CALL  STRINGS0UT( ,HOLD$LIT( 1 )+J ,NUM$3EF0RE ) ; 

IF  NUPt  AFTER  > DSC  THEN  NUP$ AFTER  = DEC; 

CALL  STRING$OUT( .HOLD$LIT(l)  + LIT$DEC,  NUMiAFTER ) ; 
IF  ( I :=DEC  - NUM$AFTER)<>0  THEN 
CALL  FILL$STRING(I,'0')J 

end; 

IF  NOT  VALUE$FLAG  THEN  PENDI NG$LITERAL=0 ; 

END  redef$or$valoe; 

REDUCE$STACK:  PROCEDURE; 

DECLARE  HCLDSLENGTH  ADDRESS; 

CALL  SET$CUR$STMJ 

CALL  redff$or^falue; 
hold$length=gft$s$length; 

IF  GET$TYPE  > 128  TEEN 

do; 

HOLD*LENGTH=HOLD$LENGTH  * GET$OCCURS? 

end; 

ID$STACK$PTR=ID$STACK$PTR  - 1J 
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CALL  set$cur$sym; 

CALL  SETA S $LENGTH( GST $S ALSNGTH  + EOLD$LENGTH ) J 
CALL  SE?$TYPE(GROUP )? 

END  REDUCE$STACK? 

ENDAOF$RECORD : PROCEDURE? 

DO  WHILE  I D$STAC5$PTR  O 0? 

CALL  SET$CURASYM? 

CALL  REDEF$ORAVALUE» 

ID$STACI( ID$STACKAPTR)=0; 

id$stackaptr*id$stack$ptr  - i; 
end; 

CALL  SET$CUR$SYM? 

CALL  REDSPAORAVALUE? 

ID$STACK( 0 )=0? 

TEMPAHOLD= ALLOC ATE( TEM P$TW0 :=GET$S ^LENGTH  ) ? 

END  END A0F$REC0RD? 

CON VERT$ INTEGER : PROCEDURE? 

DECLARE  INTEGER  ADDRESS? 

I NTEGER=0  ? 

DO  I * 1 TC  V ARC ( 0 ) ? 

IE  NOT  DIffIT(fAHC(I))  THIN  CALL  PRINT$ERR0R ( 'NN  ' ) ? 

/*  ERROR  RECOVERY  FOR  AN  '0 ' WHICH  SHOULD 
HAVE  BEEN  A ZERO— '0'  */ 

IF  ( V ARC ( I ) = 'O')  THEN  VARC(I)  = '0'? 

INTEGER=SHL( INTEGER ,3 )+SHL ( I NTEGER , 1 )+( VARC ( I ) - '0 ' ) ? 
END? 

VALUE(SP)»INTEGER? 

END  CONVERTAINTEGER? 

ORAVALUE:  PROCSDURE(PTR,ATTRIB); 

DECLARE  PTF  BYTE,  ATTRIB  ADDRESS? 

VALUE ( PTR ) =VALUE ( PTR)  OR  ATTRIB? 

END  OR$V ALUE? 

BUILD$FCB:  PROCEDURE? 

DECLARE  TS*P  ADDRESS? 

DECLARE  BUETER(ll)  BYTE,  (CHAR,  I,  J)  BYTE? 

CALL  ?ILL( .BUFFER, ' ',11)? 

J,I*0? 

DO  WHILE  (J  < 11)  AND  (I<  VARC(0))? 

IF  ( CHAR :*V ARC (I:*I+1 ))*'.'  THEN  J=8? 

ELSE  DO? 

BUFFER (J)*CHAR? 

J=J+1? 

END? 

END? 

CALL  SET$ ADDR2( TEMP  :=ALLOCATE( 165)  ) ? 

CALL  STARTAINITIALI ZE(TEM?,37)? 

CALL  BYTE$  CUT ( 0 ) ? 

CALL  STRING$OUT( .BUFFER, 11)? 

CALL  FILL$STRING( 25,0)? 

CALL  OR$VA LUE ( SP-1 , 1 ) ? 
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END  build$fcb; 

SET$S IGN  : PROCEDURE! NUMB) ; 

DECLARE  NUMB  BYTE? 

I?  GET$TYPE=17  THEN  CALL  SET$TYPE(VALUE(SP ) + NUMB)) 

ELSE  CALL  PRINT$ERROR(  'SO'  )» 

IF  VALUE(SP)<>0  THEN  CALL  SET$S$ LENGTH (GET$S$LENGTH  + 1) 
END  set$sign; 


NUM$TRUNC : PROCEDURE; 

DECLARE  I BYTE, 

J BYTE, 

TRUNC$TYPE  BYTE, 
TRUNC$ZERO  BYTE, 
SIGN$FLAG  BYTE, 
DEC$FLAG  BYTE? 


TRUNC$  ZERO  = TRUE? 

SIGNSTLAG  = FALSE? 

DEC$FLAG  * FALSE; 

HOLD$LIT ( 0 ) = 0J 
J = i; 

I = 0; 

IF  ( (TRUNC$TYPE:=GET$TYPE)=16)  OR  (TR’NC*TYPE=17)  OR 
( TRUNC$TYPE  = 21)  THEN 
DO  WHILE  J <=  YARC(0); 

IF  (VARC(J)  <>  ' + ')  AND  (VARC(J)  <>  THEN 

DO? 

IF  (VARC( J)*'0')  AND  TRUNC^ZERO  THEN  J=J; 

ELSE  IF  ((YARC(J)  >=  '0')  AND  (YAPC(J) 

<='9'))  OR 

( 7ARC ( J ) = ' ) THEN 

do; 

IF  DIC4FLAG  AND  (VARC(J)  = '.')  THEN 
CALL  PRINTS  ERROR!  'MD ' ) J 
ELSE  do; 

HOLD$LIT(HOLD$LIT(0) : = HOLD$LIT (0 ) +1 ) 

=varc(j); 

IF  VARC(J)  <>  '0'  THEN  TRUNC$ZERC  = FALSE 
IF  VARC(J)  * THEN  DEC$FLAG  = TRUE; 
I*I+i; 
end; 

end; 

ELSE  IF  ((VARC(J)  < '0')  OR  (VARCfJ)  > '9'))  AND 
(YAPC(J)  <>  '.')  THEN  CALL  PR  I NTS ERROR!  'NN' ) ; 

end; 

ELSE  IF  S IGN$FLAG  THEN  CALL  PR INTSERROR ( 'MS ' ) J 
ELSE  IF  ( V ARC ( J)  * '+')  OR  (YARC(J)  = '-')  THEN 

do; 

IF  TRUNC$TYPE  = 16  THEN  CALL  PR INT$ERROR ! 'SG ' ) ? 

ELSE  do; 

HOLDS  LIT! HOLDS  LI  T(  0 ) :=HOLD$LI T(0  ) +1 ) = VA  RC  ( J ) .* 
SIGN$FLAG  * TRUE? 

I*I+U 
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end; 

end; 

j = j ♦ 1; 

end;/*  do  while  loop  */ 

HOLD$LIT (0  ) = I? 

IF  ( ( HOLD$L IT ( 0 ) = 1)  AND  ( (HOLD$LIT( 1 ) = '+ 
(HOLD$LIT( 1 ) = '-')))  OR  ( HOLD$LIT( 0 ) = ' 

do; 

HCLD$LIT ( 0 ) = 0; 

HOLD$LIT ( 1 ) = 0J 

end; 

END  NUMiTRONC; 

PICiANALIZER:  procedure; 


DECLARE  /* 

WORK  AREAS 

AND  VARIABLES 

FLAG 

BYTE, 

FIRST 

BYTE, 

COUNT 

ADDRESS, 

BUFFER  (31) 

BYTE, 

SAFE 

BYTE, 

REPITITIONS 

ADDRESS , 

J 

ADDRESS  , 

DECiCOUNT 

BYTE, 

CHAR 

BYTE, 

I 

BYTE, 

TEMP 

ADDRESS  , 

TYPE 

BYTE, 

DEC5FLAG 

BYTE, 

I 

BYTE, 

/*  * * MASKS 

* * */ 

ALPHA  LIT 

'1'. 

A $ ED  IT  LIT 

'2', 

A$N  LIT 

'4', 

EDIT  LIT 

'a'. 

NUM  LIT 

'16', 

NUM$  EDIT  LIT 

'32', 

DEC  LIT 

'64', 

SIGN  LIT 

'128', 

NUM$MASK 

LIT 

'10101111B  ', 

NUM$ED$MASK 

LIT 

'10000101B ' , 

S $NUM$MASK 

LIT 

'00101111B  ' , 

ALPHA$MASK 

LIT 

'111111103', 

A*E$MASK 

LIT 

' 11 111100B  ' , 

A$N$MASK 

LIT 

'111010103 ' , 

A$N$E*MASK 

LIT 

'11100000B  ' , 

/*  TYPES  */ 
NETTPE  LIT  '80', 
NTYPS  LIT  '16', 
SNTTPE  LIT  '17', 
ATTPE  LIT  '8', 
AETTPE  LIT  '72', 


')  OR 
0')  THEN 
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ANTYPE  LIT  '9', 

ANETYPE  LIT  '73'j 

INC*COUNT:  PEOCEDURE(  SWITCH) ! 

DECLARE  SWITCH  BYTE? 

FLAG=FLAG  OR  SWITCEJ 

IF  ( COUNT :=COUNT  + 1)  < 31  THEN  3UFFER ( COUNT ) 

— CH  A R t 

END  INCSCOUNTJ 

CHECK:  PROCEDURE  (MASK)  BYTE? 

/*  THIS  ROUTINE  CHECKS  A MASK  AGINST  THE 
FLAG  BYTE  AND  RETURNS  TRUE  ID  THE  FLAG 
HAD  NO  BITS  IN  COMMON  WITH  THE  MASK  */ 

DECLARE  MASK  BYTE; 

RETURN  NOT  ( (FLAG  AND  MASK)  <>  d)i 
END  check; 

PICi ALLOCATE:  PROCEDURE ( AMT ) ADDRESS; 

DECLARE  AMT  ADDRESS » 

IF  (MAX$INT*MEM:«MAX$INT$MEM  - AMT) 

< NEXT$AV AI LABLE 

THEN  CALL  FATAL$ERROR  ('MO')? 

RETURN  MAXSINTSMEMJ 

END  picsallocate; 

/*  PROCEDURE  EXECUTION  STARTS  HERE  */ 

curSsym  = hold$sym; 

IF  ( GET$ LEVEL  = VALUE$LEVEL)  THEN  VALTJE$FLAG  = FALSE,* 
EEC$FLAG  = FALSE; 

COUNT, FLAG  ,DEC$COUN T=0,* 

/*  CHECK  FOR  EXCESSIVE  LENGTH  */ 

IF  7 ARC ( 0 ) > 3?  THEN 

do; 

CALL  PR  I NT $ ERR OR ( 'PC')? 
return; 

end; 

/*  SET  FLAG  BITS  AND  COUNT  LENGTH  */ 

I =i; 

DO  WHILE  I<*VARC(0)  J 

IF  (CBAR:*VARC(I ) )='A'  THEN  CALL  I NC$COUNT ( ALPHA ) J 
ELSE  IF  CHAR  « 'B ' THEN  CALL  INC$CCUNT( A*SDIT) ; 

ELSE  IF  CHAR  *'9'  THEN  CALL  INCACC’JNT  ( NUM)  ; 

ELSE  IF  CHAR  *'X'  THEN  CALL  lNC$COUNT( A$N ) J 

ELSE  IF  (CHARTS')  AND  (COUNTS)  THEN 

FLAG*FL AG  OR  SIGN; 

ELSE  IF  ( CHAR  =»  '?')  AND  ( UEC$COUNT=0 ) THEN 

do; 

DEC$COUNT  * COUNT; 

DEC$FLAG  = TRUE; 

end; 

ELSE  IF(CHAR='/')  OR  (CHAP«'0')  THEN 
CALL  I NC$ COUNT £( EDIT ) { 
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ELSE  IF 

(CHAR='Z')  OR  ( CHAP*  ' , ' ) OR  (CHAR-'*') 
(CHAR=  ' + ' ) OR  (CHAR*'-')  OR  (CHAR-'4') 
CALL  INC$COUNT(NUM$EDIT); 

ELSE  IF  (CHAR-'.')  AND  ( DEC$COUNT=0  ) THEN 
do; 

CALL  INCiCOUNT(NUMiEDIT); 

dec$coont-count; 

DECiFLAG  = TRUE; 

end; 

ELSE  IF  ((CHAR-'C')  AND  ( 7 APC ( I +1  )»  'R  ' ) ) OR 
( (CHAR-  'D  ' ) AND  (VARC ( I+l )»'B' ) ) THEN 

do; 

CALL  INC$COUNT(NDM$EDIT) ; 

CHAR-VARC ( I : = I+1 ) 5 
CALL  INC$COUNT(NUM$EDIT)  J 

end; 

ELSE  IF  (CHAR-'(')  AND  (COUNTO0)  THEN 

do; 

SAVE-VARC ( I —1 ) ; 

REPITIT ICNS=05 

DO  YHILE(  CHAR: -v  ARC ( I :*I+1  ))<>')  '.* 
REPITITI0NS=SHL(REPITITI0NS,3)  + 
SHL(REPITITICNS ,1)  +(CHAE  -'0'); 
end; 

char -save; 

DO  J=1  TO  REPITITIONS-l J 
CALL  INC$CODNT( 0) ; 

end; 

end; 

else  do; 

CALL  PRINT$ERR0R( 'PC'); 

return; 

end; 

i-i+i; 

END;  /*  END  OF  DO  *5ILE  I<=  VARC 
/*  AT  THIS  POINT  THE  TTPE  CAN  BE 
IF  NOT  CHECK  ( MUttiEDI  T ) THEN 


OR 

THEN 


*/ 

determined 


*/ 


do; 

IF 

end; 

ELSE  IF 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 


CHECK(NUMiEDiMASK)  then  type=nettpe; 


CHECK ( NUM$MASK ) THEN  TTPE-NTYPF; 
CHECK (SNUM$ MASK  ) THEN  TTPE-SNTTPEJ 
CHECK ( ALPHA $M ASK ) THEN  TTPE  * ATTPE; 
CHECK  'AiSSMASK)  THEN  TTPE  * AETTPEJ 
CHECK ( A$N$M ASK ) THEN  TYPE-ANTYPEJ 
CHECK (A$Ni£$M ASK)  T*SN  T YPE-AN2TYPEJ 
IF  TYPE-0  THEN  CALL  PRINT$ERRCR ( 'PC  ' ) ; 

ELSE  do; 


IF 

IF 

IF 

IF 

IF 


IF  ( GETiTTPE-128 ) THEN  CALL  S ET$ TYPE* 12. »+ TYPE) ; 

ELSE  CALL  SETATYPE ( TYPE ) 5 

CALL  S ET iS LENGTH ( COUNT  ♦ GET$S  iLENGTH ) * 

IF  (TTPE  AND  64)  <>  0 THEN 
DO? 
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CALL  SET$ADDR2  ( TEMP := PIC $ALLOC ATE ( COUNT  ) ); 

CALL  STARTS  INITIALIZE (TEMP .COUNT) J 
CALL  STRING$0UT( .BUFFER  + 1, COUNT); 

END,* 

IP  (DEC$COUNT  <>  0)  OR  DEC$FLAG  TFEN 

do; 

I?  (COUNT  - DECS COUNT ) > 18  THEN 
CALL  PRI NTSERROR ( 'DC') J 
CALL  SETS  DEC IMAL (COUNT  - DECSCOUNT)? 

end; 

end; 

IF  (NOT  TRUNCSFLAG)  AND  ((TYPE  = 16)  OR  (TYPE  = 17))  THEN 

do; 

DO  K * 0 TO  HOLD$LIT(0); 

V ARC ( K ) = HOLDSLIT(K); 

end; 

call  num$trunc; 

TRUNCSFLAG  = TRUE; 

end; 

end  picsanalizer; 

SETSFILESATTRI 3 : PROCEDURE? 

DECLARE  TEMP  ADDRESS,  TYPE  BYTE? 

IF  CURSSYMO  VALUE  (MPP1 ) THEN 
DO? 

temp-cup.Ssym; 

CUR$SYM=VALUE(MPP1); 

symbol$addr(rel$id)=tfmp; 

end; 

IF  NOT  ( TEMP: = VALUE ( S?-l ) ) THEN  CALL  P?lNT$ERROR  ('NF')J 
ELSE  do; 

IF  TEMP=1  THEN  TYPE-SECUENTI ALJ 
ELSE  IF  TEMP=1S  THEN  TY?E=RANDOM; 

ELSE  IF  (TEMP-5)  OR  (TFMP=13)  THEN 

type  = seqsrelative; 

ELSE  do; 

call  printserror( 'ia' ); 

TYPE*i; 

end; 

end; 

CALL  SETSTYPE( TYPE)  ? 

END  setsfilesattrib; 

LOADSLITERAL:  PROCEDURE (LITSONE) * 

DECLARE  I BYTE, 

LITSONE  BYTE, 

LITSTYPE  BYTE? 

LITSTYPE  = GETSTYPE; 

IF  LITSTYPE  <>  0 THEN  VALUESFLAG  * FALSE? 

ELSE  do; 

VALUESFLAG  = TRUE; 

VALUESLEVEL  » GETSLEVEL? 

end; 


IF  PEND I NG A LITERAL  <>  0 THEN  CALL  PRINTAERRCR  ('LF')J 
ELSE  IF  (LITAONE  = 0)  CP.  (LITATYPE  = 0)  THEN 

do; 

DO  I = 0 TO  VARC(0)? 

HOLD$LIT( I ) * 7ARC(I); 

end; 

IF  (LITAONE  = 1)  AND  ( LITATYPE  = 0)  THEN 
TRUNC$FLAG  = FALSE; 

end; 

ELSE  IF  (LIT$ONE  = 1)  AND  ((LITATYPE  = 16)  OR 

(LITATYPE  = 17)  OF  ( LITATYPE  = 21))  THEN 
CALL  NUM$TRUNC; 

ELSE  IF  (LITAONE  = 1)  AND  ( ( LIT$TYPE  <>  16)  OR 

(LITATYPE  <>  17)  OP  ( LITATYPF  <>  21))  AND 
( LITATYPE  <>  0)  THEN 

do; 

CALL  PRINT$ERR0R ( 'LV  ' ) ? 

DO  I = 0 TO  7ARC(0); 

HOLDALIT(I)  = VARC(I); 

end; 

PENDING AL I TER AL  = 2; 
end; 

end  loadaliteral; 

REDEFATEST : PROCEDURE; 

DECLARE  SAVEAREDEF  3YTE, 

SAVSArEDEFAONS  ADDRESS, 

• SAVEAREDEFATWO  ADDRESS  J 
S AV  S A REDE FA ONE  = REDSFAONE? 

SAVEAREDEFATWO  = REDEFATVO? 

REDEF$CNE  = CURASYM? 

call  setacurasy*; 

REDEFATWO  = CURASYM? 

SAVEAREDEF  = REDEFJ 
REDEF  = TRUE? 

call  rsdefaorav.»lue; 

I DA  STACK ( I D$ STACKS  PTR  ) = 0J 
IDASTACKAPTR  = IDASTACKAPTR  - 1J 
RIDEFAONE  = S AVEAREDSFAONE? 

REDEFATWO  = SAVEAR  EDEFATWO? 

REDEF  = SAVEAREDEF? 

END  redefAtest; 

CHECK ALVL$FILES : PROCEDURE? 

DECLARE  NEVA LEY EL  BYTE? 
holdasym,curAstm=valuf(mp-d  ; 

CALL  SETA  LEVEL ( NEW  ALEV  EL : =VALUE( IP-2 ) ) ; 

IF  NEVALEVEL  = 1 THEN 

do; 

IF  IDASTACK ( 0 ) <>  0 THEN 

do; 

DO  WHILE  STACKALEVEL  > 1? 

CALL  reduceastack; 
end; 
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DO  WHILE  IDiSTACKiPTR  <>  0? 


call  sETicuRisYM? 

CALL  redef$or$value; 

ID$STACK( I DiSTACKiPTR  ) = 0; 

I DiSTACKiPTR  = IDiSTACKiPTR  - 1J 

end; 

CUR$STM  = hold$sym; 

CALL  SET$REDEF( IDiSTACK( 0) , V ALUE( MP-1 ) ) » 
VALUE(MP)  = I?/*  SET  REDEFINE  FLAG  */ 

end; 

end; 

ELSE  DO  WHILE  STACKiLE7EL  >*  NEWiLEVEL? 

CALL  reduce$stack; 
end; 

END  CHECKiLVLi FILES ; 

CHECKiLVLiWORK : PROCEDURE? 

DECLARE  NEWiLEVEL  BYTE, 

SAVEiSYMiLVL  BYTE, 

STACKiREDUCED  BITE, 

SAVEiREDEF  BYTE, 

SAVEiSYM  ADDRESS? 

SSTiV  ALU Ei CLAUSE  : PROCEDURE? 

SAVEiREDEF  = REDEF? 

REDS?  = FALSE? 

CALL  SETiCURiSIM? 

CALL  REDEFiORiVALUE? 

REDEF  = SAVEiREDEF? 

CURiSYM  = HCLDiSYM? 

END  SETi7ALUEi CLAUSE? 

TRUNCiFLAG  * TRUE? 

STACKiREDUCED  = FALSE? 

HO L Di S YM , CUR iS  YM= VALUE ( MP-1 ) ; 

CALL  SET$LEVEL'NEW$LEVEL:=VALUE(M?-2) ) ? 

I?  NEWiLEVEL  = 1 THEN 

do; 

DO  WHILE  STACKiLEVEL  > 1 AND  I D$ STACKS IDiST'CKiPT- ) <>0? 
SAVEiSYM , CURiS YM=IDiSTACK (IDiSTACKiPTR  - 1)? 

SAVEiSYMiLVL  = GETiLSVELJ 
IF  SAVEiSYMiLVL  = STACKiLEVEL  THEN 

do; 

CURiSYM  = SAVEiSYM? 

CALL  REDEFiTEST? 

end; 

ELSE  IF  STACKiLEVEL  > 1 THEN 

do; 

CALL  REDUCEiSTACK; 

IF  VALUEiFLAG  »ND  ( VALUEiLSVSL  = STACKiLEVEL)  THEN 

do; 

VALUEiFLAG  = FALSE? 

CALL  SETiVALUEiCLAUSSJ 

end; 
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end; 

end;/*  do  while  loop  */ 

IF  STACKSLEVEL  = 1 AND  IDSSTACKSPTR  <>  0 THEN 

do; 

CUR$SYM  = ID$STACK(ID$STACK$PTR  - 1); 

CALL  redefStest; 
end; 

if  value ( mp ) = 0 and  idSstack(idSstacksptr)  <>  0 then 
do; 

call  endsofsrecord; 

REDEF  = FALSE; 

end; 

IF  ( VALUE (MP)  = 1)  AND  ( I DSSTACK ( ID$STACK$?TR ) = REDEF$ONE) 
THEN  CALL  SETSVALUSSCLAUSS f 
CURSSYM  = holdSsym; 
end; 

ELSE  IF  STACKSLEVEL  >=  NEW$LEVEL  THEN 

do; 

IF  (STACKUEVEL  = NEVSLEVEL ) AND  (VALUE(MP)  = 1)  AND 
( IDS STACK ( IDSSTACKSPTR  ) = REDEFSONE)  THEN 
CALL  SETSVALUESCLAUSE; 

DO  WHILE  NOT  STACKSREDUCED ; 

SAVES SIM ,CURSS  YM= IDS STACK (IDSSTACKSPTR  - 1); 

saveSsymSlvl  * setslevel; 

IF  SAVESSYMSLVL  = STACKSLEVEL  THEN 

do; 

CURSSYM  = savessym; 

CALL  REDEFSTSST; 
end; 

ELSE  IF  (STACKSLEVEL  >*  NE«  SLEVEL ) AND 
(VALUE(MP)  = 0)  THEN 

do; 

DO  WHILE  STACKSLEVEL  >=  NEW$LEVELJ 
CALL  REDUCSSSTACK; 

IF  VALUESFLAG  AND  (VALUESlEVSL=STACKSLEVSL) 

AND  (VALUESLEVEL  = NEWSLFVEL)  THEN 

do; 

valuesflag  * false; 
call  sstsvaluesclause; 
end; 

end;/*  do  while  loop  */ 
stacksreduced  * true; 
end; 

ELSE  IF  (STACKSLEVEL  >=  NEVSLEVEL)  AND 
(VALUE(MP)  = 1)  THEN 

do; 

DO  WHILE  STACKSLEVEL  > NEWSLEVEL5 
CALL  REDUCESSTACK,* 

IF  VALUESFLAG  AND  (VALUESLEVEL  =*  STACKSLEVEL) 

THEN  DO? 

VALUESFLAG  * FALSE; 

CALL  setsvalusSclause; 
end; 


end;/*  do  while  loop  */ 
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STACK$F.EDUCED  = TRUE? 

end; 

end;/*  do  while  loop  */ 
end; 

cur$sym  = hold$sym; 

END  CHECK$L VL$  WORK? 

CODE$GEN  : PROCEDURE( PRODUCTION  ) ; 

DECLARE  PRODUCTION  BYTE, 

LIT$TYPE  BYTE; 

IF  PRINT$PROD  THEN 

do; 

CALL  CPLFJ 

CALL  PRINTCHAR (POUND); 

CALL  PR  I NT$ NUMBER (PRODUCTION  ) J 

end; 

DO  CASE  production; 

/*  productions*/ 

/*  CASE  0 NOT  USED  */ 

9 

/*  1 <PROGRAM>  ::=  <ID-DIV>  <?-DIV>  <D-DIV>  PROCEDURE  */ 

do; 

compiling=false; 

DISPLAY  (DISPLAY(0)+1)='$  '; 

CALL  PR  I NT ( .DISPLAY(l)  )» 

end; 

/*  2 <ID-DIV>  ::=  IDENTIFICATION  DIVISION  . PROGRAM-ID  .*/ 
/*  2 <COMMENT>  . <AUTH>  <DATE>  <SEC>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  3 <AUTH>  AUTHOR  . <COMMENT>  . */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  4 \!  <SMPTY>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*  5 <DATE>  ::=  DATE-WRITTEN  . <COMMENT>  . */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  6 \!  <EMPTY>  */ 

f /*  NO  ACTION  REQUIRED  */ 

/*  7 <SEC>  SECURITY  . <COMMENT>  . */ 

5 /*  NO  ACTION  REQUIRED  */ 

/*  8 \ ! <EMPTY>  */ 


• 

9 

/* 

NO  ACTION 

REQUIRED  */ 

/* 

9 

<CCMMENT> 

: :=  <InPUT> 

*/ 

• 

9 

/* 

NO  ACTION 

REQUIRED  */ 

/*10 

\ ! <COMMENT>  <INPUT> 

*/ 

• 

9 

/* 

NO  ACTION 

REQUIRED  */ 

/*11  <E-DIV>  ENVIRONMENT  DIVISION  . CONFIGURATION  */ 
/*11  SECTION  . <SRC-OBJ>  <I-0>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*12  < SRC-OBJ>  SOURCE-COMPUTER  . <COMMENT>  <DEBUG>  .*/ 
/*12  OBJECT-COMPUTER  . <COMMENT>  . */ 

; /*  NO  ACTION  REQUIRED  */ 
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/*13  <DEBUG>  ::=  DEBUGGING  MOVE  */ 

dfbugging=true;  /*  SETS  a scanner  toggle  */ 

/*14  \ I <EMPTY>  */ 

; /*  NO  ACTION  required  v 

/*15  <I-0>  ::*=  INPUT-OUTPUT  SECTION  . FILS-CONTROL  . */ 

/*15  <FI LE-CONTROL-LIST>  <IC>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*16  \ ! <EMPTY>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*17  <FILE-CONTROL-LlST>  : <?ILE-CONTROL-ENTRT>  */ 

; /*  NO  ACTION  REQUIRED  V 
/*18  \t  <FI LE-CONTROL-LI ST>  */ 

/*18  <FILE-CONTROL-ENTRY>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*19  <FI LE-CONTROL-ENTRT>  ::=  SELECT  <ID> 

<ATTRIBUTE-LIST>  . */ 

CALL  SET$FILE$ATTRIBJ 

/*20  <ATTRI BUTS-LIST>  : :=  <0NS-ATTRI3>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*21  \ ! < ATTRIBUTE -LIS T>  <0NE-ATTRIB>  V 

VALUE(M?)=VALUE(SP)  OR  VALUE(MP); 

/*22  <ONS-ATTRIB>  ::=  ORGANIZATION  <ORG-TYPS>  */ 

VALUE ( MP )=V  ALUE ( SP  ) » 

/*23  \l  ACCESS  <ACC-TYPS>  <RELATI 7E>  */ 

V ALUE (MP)=V ALUE (MPP1 ) OR  VALUE(SP); 

/*24  \ ! ASSIGN  <INPUT>  */ 

CALL  BUILDiFCBJ 

/*25  <ORG-TYPE>  : SEQUENTIAL  */ 

; /*  NO  ACTION  REQUIRED  - DEFAULT  */ 

/*26  \ ! RELATIVE  */ 

CALL  OR$VALUE (SP  ,4)  * 

/* 27  <ACC-TYPE>  SEQUENTIAL  */ 

; /*  NO  ACTION  REQUIRED  - DEFAULT  */ 

/*28  \f  RANDOM  */ 

call  or  Lvalue (sp  ,2) * 

/*29  <RELATIVE>  RELATIVE  <ID>  */ 

CALL  OR$V  ALUE (MP  ,8 ) * 

/*30  \!  <EMPTY>  */ 

,*  /*  NO  ACTION  REQUIRED  - DEFAULT  */ 

/*31  <IC>  ::=  I-O-CONTaOL  . <SAMS-LIST>  */ 

• 

/*32  \!  <EMPTY>  */ 

t 

/*33  <SAME-LIST>  <S AME-SLSMENT>  */ 

/*34  \ ! <S AME-LI ST>  <SAME-ELEMENT>  V 

9 

/*35  <SAME-ELEMENT>  SAME  <ID-STRING>  . */ 

/*36  <ID-STRING>  ::=  <ID>  */ 

/*37  \!  <ID-STRI NG>  <ID>  */ 
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/*38  <D-DIV>  : DATA  DIVISION  . <FILE-SECTI0N>  <WORK>  */ 

/*3e  <LINK>  */ 

5 /*  NO  ACTION  REQUIRED  */ 

/*39  <FI LE-SECTION>  FILE  SECTION  . <FILE-LIST>  */ 
FILE$SEC$END  = TRUE; 


/*40  \ ! <EMPTY>  */ 

file$sec$end=true; 

/*41  <FI LE-LIST>  <FILES> 

*/ 

; /* 
/*42 

NO  ACTION  REQUIRED  */ 

\!  <FILE-LIST>  <FILES> 

*/ 

; /* 
/*43 

NO  ACTION  REQUIRED  */ 
<FILES>  ::=  FD  <ID>  <?ILE- 

CONTROL> 

/*43 

<RECORD-DESCRIPTION> 

*/ 

do; 

do 

WHILE  STACK$LEVEL  > 1J 

CALL  reduce$stack; 
end; 

call  enb$cf$reccrd; 
redef=false; 
end; 

/*44  <FILE-CONTROL>  ::=  <?ILE-LIST>  */ 

CALL  SETiIO$ADDRSJ 
/*45  \ ! <EMPTY>  */ 

CALL  SET$IO$ADDRS; 

/*46  <FILE-LIST>  <F ILE-ELEMENT>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*4?  \I  <? ILE-LI ST>  <?ILE-ELEMENT>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*48  <FILE-ELEMENT>  : BLOCK  <1 NTEGER>  RECORDS  */ 

J /*  NO  ACTION  REQUIRED  - FILES  NEVER  3LCCKEB  ♦/ 
/*49  \ ! RECORD  <REC-COUNT>  */ 


CALL  SET$SLENGTH( VALUE (SP)  ); 

/*50  \!  LABEL  RECORDS  STANDARD  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*51  \!  LABEL  RECORDS  OMITTED  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*52  \ ! VALUE  OF  <ID-STRING>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*53  <REC-COUNT>  : :=  <INTEGER>  */ 

! /*  NO  ACTION  REQUIRED  - VALUE(SP)  CORRECT  */ 
/*54  \ I <INTEGER>  TO  <INTEGER>  */ 

do; 


VALUE(MP)=V»LOE(S?) ; /*  VARIABLE  length  */ 

CALL  SET$TTPE(4);  /*  SET  TO  VARIABLE  */ 

end; 

/*55  <WORK>  WORKING-STORAGE  SECTION  . */ 

/*55  <RECORD-DESCRIPTI ON>  ♦/ 

DC? 

DO  WHILE  STACKHEVEL  > 1} 

CUR$STM  = IDASTACK ( ID$STACK$PTR  - 1); 

IF  GET$LEVEL  = STACK$LEVEL  THEN 
CALL  redef$test; 

ELSE  IF  STACK$LEVEL  > 1 THEN 

CALL  reduce$stack; 
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<RECORD-DESCRIPTION>  */ 


END? 

IT  STACKSLEVEL  = 1 AND  IDSSTACK$PTR  <>  0 THEN 

do; 

CURSSYM  = IDSSTACK(ID$STACK$PTR  -1)5 
IT  REDET  THEN  CALL  REDETSTESTJ 

end; 

CALL  ENDSOT$RECORD; 

end; 

/*56  \ I <EMPTY>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*57  <LI NK>  LINKAGE  SECTION  . <RECORD-DESCR IPTION>  */ 
CALL  PRINT$ERR0R( 'NI ')  ; /*  INTER  PROG  COMM  */ 

/*58  \!  <EMPTY>  #/ 

J /*  NO  ACTION  REQUIRED  */ 

/*59  <RECORD-DESCRIPTION>  : <LEVEL-ENTRY>  V 
5 /*  NC  ACTION  REQUIRED  */ 

/*60  \ ! <RECORD-DES CE I PTION>  */ 

/*60  <LEVEL-ENTRY>  */ 

; /*  NC  ACTION  REQUIRED  */ 

/*61  <LEVEL-ENTRY>  : :=  <INTEGEP>  <D«TA-ID>  < REDET I NTS > */ 
/*61  <DAT A-TYPE>  . */ 

do; 

call  load$level; 

IF  (PENDING$LITERAL  <>  0)  AND  (NOT  VALUES  FLAG ) THEN 
PENDING$LIT$ID  = IP$STACK$ PTR ; 

end; 

/*62  <DATA-ID>  <ID>  */ 

5 /*  NO  ACTION  REQUIRED  */ 

/*63  \ ! FILLER  */ 

do; 

CURSSYM,  valus(s?)=nex?ssym; 

CALL  BUILDS  SYMBOL ( 0 ) I 

end; 

/*64  <REDE?INSS>  = REDEFINES  <ID>  */ 

do; 

CALL  SETS REDET ( VALUE (SP) , VALUE ( SP-2 ) ) ; 

VALUE ( MP )=1 J /*  SET  REDEFINE  FLAG  ON  */ 

IF  NOT  TILESSECSEND  THEN 
CALL  PRINTS  ERROR  ( 'R3')  J 
CALL  CHECKS IVLSWORKJ 
end; 

/*65  \!  <EMPTY>  */ 

do; 

IF  NOT  TILESSECSEND  THEN 
CALL  CHECKS LVL STILES; 

ELSE  CALL  CHE CK$LVLS*ORK ! 

end; 

/*66  <DATA-TYPE>  = <PR0P-LIST>  */ 

J /*  NO  ACTION  REQUIRED  V 
/*67  \!  <EMPTY>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*68  <PROP-LIST>  <DATA-SLEMENT>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*69  \I  <PROP-LIST>  <DATA-SLEMENT>  */ 


1 


1 


J /*  NO  ACTION  REQUIRED  */ 

/*70  <DATA-ELEMFNT>  PIC  <INPUT>  */ 

CALL  PICiANALIZERJ 
/*?1  \!  USAGE  COMP  */ 

CALL  SETATYPE ( COMP ) > 

/*72  \f  USAGE  DISPLAT  */ 

J /*  NO  ACTION  REQUIRED  - DEFAULT  */ 

/*73  \ ! SIGN  LEADING  <SEPARATS>  */ 

CALL  SET$SIGN(17); 

/*?4  \ ! SIGN  TRAILING  <SEPARATE>  */ 

CALL  SET$SIGN(18)J 
/*75  \ ! OCCURS  <INTEGER>  */ 

do; 

CALL  OR$TTPE( 128) ; 

CALL  SET A OCCURS ( 7ALUE( SP  ) ) ; 

end; 

/*76  \ ! STNC  <DIRECTI0N>  */ 

; /*  NO  ACTION  REQUIRED  - BYTE  MACHINE  */ 
/*77  \!  VALUE  <LITERAL>  */ 

do; 

IF  NOT  FILEASECAEND  THEN 

do; 

CALL  PRINT$EP.ROR(  'VE')J 
PENDI NG$LITER AL=0; 

end; 
end; 

/*78  <DIRECTION>  LEFT  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*79  \!  RIGHT  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*80  \!  <EMPTY>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*81  <SEPARATE>  ::=  SEPARATE  */ 

VALUE( SP)=2; 

/*82  \!  <EMPTY>  */ 

\ ; /*  NO  ACTION  REQUIRED  */ 

/*83  <LI TERAL>  : <INPUT>  */ 

do; 

IF  ( ( LITATTPE  :=GETATTPE)  <>  16)  AND 
(LITSTYPE  <>  17)  AND  (LITATYPE  <>  21)  THEN 

do; 

CALL  PRlNTAERP.OR(  'NV'  ); 

CALL  LOAD$LITERAL(0); 

PENDINGALITERAL  = 2? 

END; 

ELSE  do; 

CALL  LOADiLITEPAL(l) ; 

PENDINGALITERAL  * 1? 

end; 

end; 

/*84  \ ! <LIT>  */ 

do; 

CALL  LOAD$LITERAL(0) J 
PSNDING$LITERAL=2; 
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end; 

/*85  \ ! ZERC  */ 

pendingSlitepal=3; 

/*86  \l  SPACE  */ 

PENDINGSLITERAL=4? 

/*8?  \ ! QUOTE  */ 

PENDING$LITERAL=5; 

/*88  <INTEGER>  : :=  <INPUT>  V 

CALL  CONVERT* INTEGER; 

/*89  <ID>  ::=  <INPUT>  */ 

VALUE(SP)=MATCHJ  /*  STORE  SYMBOL  TABLE  POINTERS  */ 


END;  /*  END  OF  CASE  STATEMENT  */ 

END  codesgen; 

GETIN1:  PROCEDURE  BYTE? 

RETURN  INDEX1 (STATE); 

END  GETINU 

GETIN2 : PROCEDURE  BYTE; 

RETURN  INDEX2 (STATE ) ; 

END  GETIN2; 

incsp:  procedure; 
sp=sp  ♦ 1; 

IF  SP  >=  PSTACKS IZE  THEN  CALL  FATAL$SRROR ( 'SO  ' ) 5 
VALUE (SP  ) = 0;  /*  CLEAR  VALUE  STACK  */ 

END  incsp; 


DUPSIDENSFLAG:  PROCEDURE; 

IF  TOKEN  = 02  THEN  FI LE$DESC$FLAG  = TRUE; 
IF  TOKEN  = 47  THEN  REDEFSFLAG  = TRUE  I 

end  dupsiden$flag; 

LOOKAHEAD:  PROCEDURE? 

IF  NCLOOK  THEN 

do; 

call  scanner; 
call  dup$iden$flaj; 
nolook=false; 
if  printstoken  then 
dc; 

CALL  crlf; 

call  print$number(token ); 
call  peint$chas(  ' ' ); 
call  printSaccum; 
end; 
end; 

end  lookahead; 

NOSCONFLICT:  PROCEDURE  (CSTATE)  BYTE? 
DECLARE  ( CSTAIE , I , J ,K ) BYTE? 
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J = INDEX1 ( CSTATE  ) J 

K=J  + INDEX2(CSTATE)  - l; 

do  i=j  to  k; 

IF  EEAD1 ( I )=TOKEN  TEEN  RETURN  TRUE? 

end; 

RETURN  FALSE? 

end  no$conflict; 

RECOVER:  PROCEDURE  BITE; 

DECLARE  (TSP , RSTATE)  BYTE? 

DO  forever; 
tsp=sp; 

DO  WHILE  TSP  <>  255; 

IF  NO$CONFLICT(RSTATE:=STATESTACK(TS?)  ) THEN 
DO?  /*  STATE  WILL  READ  TOKEN  */ 

IF  SPOTS?  TEEN  SP  = TSP  - 1 J 
RETURN  RSTATE; 

end; 

TSP  = TSP  - 1; 
end; 

CALL  SCANNER;  /*  TRY  ANOTHER  TOKEN  */ 

end; 

end  recover; 

END$PASS : PROCEDURE; 

/*  THIS  PROCEDURE  STORES  TEE  INFORMATION  REQUIRED  BY 
PAPT2  IN  LOCATIONS  ABOVE  THE  SYMBOL  TABLE.  THE  FOLLOWING 
INFORMATION  IS  STORED: 

OUTPUT  FILE  CONTROL  BLOCK 
COMPILER  TOGGLES 
INPUT  BUFFER  POINTER 

THE  OUTPUT  EUFFER  IS  ALSO  FILLED  SO  TEE  CURRENT  RECORD. 
IS  WRITTEN  */ 

CALL  BYTE$OUT(SCD)  ; 

CALL  ADDR$0UT(NEXT$AVAILA3LE) ; 

DO  WHILE  OUTPUTSPTRO . OU  T PUT  $ BUFF  J 
CALL  BYTE$OUT(0F?H); 

end; 

CALL  MOVE ( . OUTPUT SFCB , MAXSMEMOP Y-P  ASS ISLEN  , PASS 1$LEN  ) ; 

L:  GO  TO  LJ  /*  PATCH  TO  ’JMP  3100H  ’ */ 

END  SNDSPASS5 

/*****  PROGRAM  EXECUTION  STARTS  HSPE  * * */ 

CALL  MCVE( INITIALS POS , M AX S MEMORY .RDRSLENGTH); 

CALL  initsscanner; 

CALL  initssymbol; 


/##*****  parser  * * # * * */ 
DO  while  compiling; 


STATE*L00K2(I); 

END; 

ELSE 

do;  /*push  states*/ 

CALL  INCSP; 

STATESTACK(SP)*GETIN2; 

STATE*GETINi; 

END* 

end;’/*  op  while  compiling  */ 

CALL  END*PASS; 

end; 


PART2 : /*  MODULE  NAME  */ 

do; 

/*  COBOL  COMPILES  - PAST  2 */ 

/*  100H  * MODULE  LOAD  POI“T  */ 

/*  GLOBAL  DECLARATIONS  AND  LITERALS  */ 

DECLARE  LIT  LITERALLY  'LITERALLY',*  DECLARE 
PASSliLEN  LIT  '48', 

MAX$MEMORY  LIT  '0D100H', 

PASSl$TOP  LIT  '0D000H  ' , 

CR  LIT  '13', 

LF  LIT  '10', 

QUOTE  LIT  '27H  ' , 

POUND  LIT  '23H ' , 

TRUE  LIT  '1' 

FALSE  LIT  '0  , 

FOREVER  LIT  'WHILE  TRUE'. 

ALPHA$LIT$FLAG  BYTE  I NI TI AL( FALSE ) , 

IF$FLAG  BYTE  INITIAL( FALS E ) J DECLARE  MAXRNO  LITERALLY 
'82',/*  MAX  READ  COUNT  */ 

MAXLNO  LITERALLY  '105',/*  MAX  LOOK  COUNT  */ 

MAXPNO  LITERALLY  '120',/*  MAX  PUSH  CCUNT  */ 

MAXSNO  LITERALLY  '219',/*  MAX  STATE  COUNT  */ 

STARTS  LITERALLY  '1 ' ; /*  START  STATE  */ 

DECLARE  READ1 ( *)  3YTE 

DAT A (0,63, 5, 6, 9, 14, 16, 20, 22, 24, 26, 31 ,32,41,42,44,45  ,49,53 

,54,58,60,48,28,48,29,28,29,36,37,48,59,11,35,46 
,34,13,28,29,36,37  ,48,3,1,40 ,23,48,57,1,56,2,30,43,27,19 

,33,50,52,64,18,4,38,28,39,4 8 ,61.55,1,15,7,12,10,51,5,9 

,14,16,20,22,24,26,31,41,42,44,45,49,53,54 
,58,60,51,7,17,1,1 

,5,9,14,16,20.21,22,24.26,31,41,42,44,45,49,53,54 
,54,59,63,46,62,8,48,25,0,0)  ; 

DECLARE  LCCKK*)  EYTE 

DATA (0,43, 0,40, 0.2, 0,40, 0.1, 15, 0,46, 0,33, 43, 0,2, 0,27, 0,7 
,0,17,0,1,15,0,55,0,55,0,55,0,55,0,1,15,3,12,0,1,0,51,0 
,48,0); ,0,25,0,3,43 
DECLARE  APPLYK*)  BYTE 

DATA (0,0,22, 0,6, 0,0, 77, 0,0, 81, 0,11 ,66,68,74,79,0,0.3,31,0 
,3,91,0,25,0,0  ,0,0,57,58,59,0,0,0,0,0,0,0,69,0,0,0,0,0,0 
,5,7,8,13,14  ,44,0,0,2,5,6,7,8,12,13,14,18.21,23,24,26 

,27,28,29,33,34,40,44,75.76  ,77,80,0,9,30,37.38,49,52,54 

.0,5,7,8,13,14 ,28,44,0,52,0,20,0,0,15,  ,32,53,65,0,0,0,3, 

91.0,7); 

DECLARE  READ2( *)  BYTE 

DATA (0,41, 6, 213, 9, 10, 83, 15, 17, 18, 20, 23, 24, 27, 29, 29, 30, 32 
,33, 34, 37, 38, 31, 201, 85, 84. 201, 205, 207, 206, 85, 178, 194. 192 
,193,185  ,172,210,205.207,206.209,202,129,26,191 

,197,86,3,35,4,189,199,21 ,167  ,168,166,161,162,14,5 

,131,201 ,25,85,39,169,2,11,7,164,174,184,6,9.10  ,83 

,16 ,17,18,20,23,27,28,29,30,32,33,34,37,38,164,8,13,130 
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,131,6,9,10  ,83 ,15, 16, 17, 16, 20, 23, 27, 28, 29, 30 

,32,33,34,37,38,19,8,40,121,198,19,0,0); 

DECLARE  L00K2( *)  3TTE 

DATA (0,12, 106, 22, 107, 198,1 99, 36, 108, 142, 142, 124, 44, 109, 45 
,45,110,46,196  ,47,111,112,49,113,52,114,114,54,56,115,57 
,116,58  ,117,59,118.119,119,63,64,120,147,67,69,139,75 

,122,78,136,128,128,81); 

DECLARE  .APPLY2 (* ) BYTE 

DATA (0,0, 137, 60, 76, 103 ,77, 127, 126, 105, 73, 72, 151, 150, 152 
,177,149,132,133,104,104,136,102,102,139,182,74,160,48 
,65,155,153  ,156,154,148,68,134,61,94,146,66,173 

,79,159,55,186,80,96,144,97 ,98  ,95,175,135,190,42,90 

,87,90,90,215,90,90,217,179,138,88,124,89,90  ,157,91 

,158, 143,90,125,125,42,145,43,92,50,51,93,203,203,53,211 
,195,195,195,195,195,195,195,200,71,70,208,212,171,62 
,99,213,163,130  ,140,141,101,101 ,147,82) ; 

DECLARE  IMDEX1(*)  BYTE 

DATA (0,1, 115, 2, 22, 115, 11 5, 115, 115, 23, 25, 73, 115, 115, 115, 
,26,31 ,32,115,35,36,115,44,115,115,26,115,115,115,115 
,23,42,26,115  ,115,43,44,23,23,45.115,47 

,48,50,115,51,50,53,54,23,59,60,23,61,62,65,  ,66,66,66 

,66,67,68,69,26,70,26,73,71 ,73,91,92,93,94,95,96,115,115,117 
,119,73,115,2,26,1,3,5,7,9,12,14,17,19,21,23,25,28,30,32 
,34,36,39,  ,41,43,45,47,49,216,123,123,176 

,187,180,204,204,133,170,170,170,170  ,214,165,1,2 

,2,4,4,6,6,7,7.9,9,10,10, 10,12,12,12,12,12,12,12,12,12,12, 
,12,12,12,12,18,18,18,18,19,19,19,19,22,22,22,25,27,27,27 
,28,28,29,29  ,29,30,30,34,34,35,35,36,36,37,37 ,38 

,38,39,39,39,40,42,43,43,44,44  ,45,45.46.46,46,47 

, 47, 54, 55, 80, 80, 80, 88, 96, 96, 96, 98, 98, 100, ie0, 100 
,101 ,101,106,106,107,107,106,111) J 
DECLARE  I NDEX2 (* ) BYTE 

DATA (0,1, 1,20, 1,1, 1,1, 1,2, 1,16, 1,1, 1,5, 1,3, 1,1, 6, 1,1,1, 

,5, 1,1,1  ,1,2,1  ,5, 1,1, 1,1, 2, 2, 2, 1,1, 2, 1,1, 2, 1,1, 5, 2, 1,1, 2 
,1,3,  ,1,1,1  ,1,1,1,1,1,5,1,5,18,2,18,1,1,1,1,1,19 

,1,2, 2,1  ,16,1,20,5,2.2,2,2,3,2,  , 3. 2, 2 , 2 ,2 ,3 ,2 

,2, 2, 2, 3, 2, 2, 2 ,2,2,3,12,22,36,44,45,47,49,52,54,56,57, 

,58, 59, 63, 64, 5, 1,0, 0,1, 0,1, 2, 2, 1,2, 0,0,2, 1,0. 2, 1,0, 2, 1,1 
,3, 3, 2, 3, 0,1,  ,2, 2, 4, 2, 5, 4. 4. 5, 1,1, 2, 2,0 

,0,1, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 1,1, 0,1,1 
,0,0, 1,2, 0,0, 0,0, 0,0,0, 0,0, 0,0, 0,0, 0,0, 3, 0,0, 0,0, 0,0, 0,0 
,0,0, 0,0, 0,0  ,1,0), 


/*  END  OE  TABLES  */ 

DECLARE 

"/*  JOINT  DECLARATIONS  */ 

/*  THE  FOLLOWING  ITEMS  ARE  DECLARED  TOGETHER  IN  THIS 
GROUP  IN  ORDER  TO  FACILITATE  THEIR  BEING  PASSED  FROM 
THE  FIRST  PART  OF  THE  COMPILER. 

*/ 

OUTPUT4FC3  (33)  BYTE. 

DEBUGGING  3YTE, 

?RINT$?R0D  BYTE, 

PRINTiTOEEN  BYTE, 
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L IS  T$ I NPUT  BITS, 

SEQ$NUM  BYTE, 

NEXT$SYM  ADDRESS, 

POINTER  AEDRESS,  /*  POINTS  TO  THE  NEXT  BYTE 

TO  BE  READ  */ 

NEXT$AVAILABLE  ADDRESS, 

MAX$INT$ME  M ADDRESS, 

HASH$TAB$ADDR  ADDRESS,  /*  ADDRESS  OF  THE  BOTTOM  OF 

THE  TABLES  FROM  PARTI  */ 

/*  I 0 BDFFEPS  AND  GLOBALS  */ 

INiADDR  ADDRESS  INITIAL  ( 5CH) , 

INPUTFCB  BASED  INADDR  (33)  BYTE, 

OUTPUT$BUFF  (128)  BYTE, 

OUTPUT$?TR  ADDRESS, 

OUTPUTSEND  ADDRESS, 

OUTPUT$CHAR  BASED  OUTPUT$PTR  BYTE; 

/*  MESSAGES  FOR  OUTPUT  */ 

DECLARE 

ERROR$NEAR$$  (*)  BYTE  DATA  ('  ERROR  NEAR  $'), 
END$OF$?ART$2(*)  BYTE  DATA  ('  END  OF  COMPILATION  $';? 

/*  GLOBAL  COUNTERS  */ 

DECLARE 
CTR  BYTE, 

AiCTR  ADDRESS, 

BASE  ADDRESS, 

3$3YTE  BASED  BASE  BYTE, 

BiADDF.  BASED  BASS  ADDRESS  ? 

MON1 : PROCEDURE  (F,A)  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 

END  MON1? 


M0N2:  PROCEDURE  (F, A)  BYTE  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 

END  M0N2? 


BOOT:  PROCEDURE  EXTERNAL? 

END  BOOT? 

PRINTCHAR:  PROCEDURE  (CHAR)? 
DECLARE  CHAR  BYTE? 

CALL  MON1  (2.CHAR)? 

END  PRINTCHAR? 

CRLF:  PROCEDURE? 

CALL  PRINTCHAR(CR); 

CALL  PRINTCHA.P.(LF)  ? 

END  CRLF? 

PRINT:  PROCEDURE  (A)? 


DECLARE  A ADDRESS? 

CALL  K0N1  (9, A); 

END  print; 

PRINTSERROR:  PROCEDURE  (CODE); 

/*  THIS  PROCIDURE  IS  USED  TO  PRINT  COMPILER  ERRORS  TO 
THE  CONSOL  */ 

DECLARE  CODE  ADDRESS, 

I BYTE, 

CODE1 ( 6 ) ADDRESS? 

IF  CODE  = FALSE  THEN 

do; 

DO  I = 0 TO  5? 

CODEl(I)  = 0? 

end; 
i = 0; 
end; 
else 

IF  CODE  = TRUE  THEN 

do; 

i * z; 

DO  WHILE(  ( 106)  AND  (CODEl(I)  <>  0)); 

CALL  crlf; 

CALL  PRINTCHAR(HIGH(C0DE1(  I) ) ); 

CALL  PRINTCHAR  ( LOW  ( C0DE1  ( I ) ) ) ; 

CCDEl(I)  = 0; 
i » i ♦ i; 
end; 
i * 0; 
end; 

ELSE 

IF  ("CODE  = 'NP')  OR  (CODE  = 'NV')  OR  (CODE  = 'SL')  THEN 

do; 

CALL  crlf; 

CALL  ?RINTCHAR(HIGH(C0DE)  )J 
CALL  PRINTCHAR ( LOW(CODS)); 

end; 

ELSE 

do; 

IF  I <>  6 TEEN 

do; 

CODEKI)  » code; 

I * I ♦ 1; 
end; 
end; 

END  printserror; 

FATALSERROR:  ?RCCEDURE( REASON  ) J 
DECLAPE  REASON  ADDRESS! 

CALL  PRINT$ERROR(REASON ) ; 

CALL  PRINTS ERR OR (TRUE  )J 
CALL  TIMK10); 

CALL  BOOT? 

END  FATALSERROR! 
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CLOSE:  procedure; 

IE  MON 2 ( 16 , . OUTPUT $ FC B ) =255  THEN  CALL  FATAL$ERROR ( 'CL' ) 
END  close; 

MORE$lNPUT:  PROCEDURE  BYTE? 

/*  READS  THE  INPUT  FILE  AND  RETURNS  TRUE  IF  A RECORD 
WAS  READ.  FALSE  IMPLIES  END  OF  FILS  */ 

DECLARE  DCNT  BYTE; 

IF  ( DCNT : *MON2 ( 20 , . IN  PUTiFCB ) ) >1  THEN 
CALL  FAT A L$ ERROR l 'BR ' ) ; 

RETURN  NOT(DCNT); 

END  more^input; 

WRITE$OUTPUT : PROCEDURE  (LOCATION); 

- /*  WRITES  CUT  A 128  BYTE  3UFFER  FROM  LOCATION*/ 

DECLARE  LOCATION  ADDRESS; 

CALL  M0N1(26, LOCATION );  /*  SET  DMA  */ 

IF  MON 2 ( 21 , . OUTPUT  $FC  3 )O0  THEN  CALL  ?ATAL$ERROR ( 'WR ' ) J 
CALL  MONl(26,e0H);  /* RESET  DMA  */ 

END  write$out?ut; 

MOVE:  PROCEDURE ( SOURCE , DESTINATION,  COUNT); 

/*  MOVES  FOR  THE  NUMBER  OF  BYTES  SPECIFIED  EY  COUNT  */ 
DECLARE  (SOURCE, DESTINATION  ) ADDRESS, 

( S$BYTS  3ASED  SOURCE,  DABYTE  BASED  DESTINATION,  COUNT) 

byte; 

DO  WHILE  (COUNT:=CCUNT  -1)0  255; 

D$3YTS=S$3YTE; 

SOURCE=SOUP.CE  + 1J 
DESTINATION  = DESTINATION  + 1J 

end; 

END  move; 

FILL:  PROCEDUREUDDR,  CHAR,  COUNT)  ; 

/*  MOVES  CHAR  INTO  ADDR  FOR  COUNT  3YTES  */ 

DECLARE  ADDR  ADDRESS, 

(CHAR, COUNT, DEST  BASED  ADDR)  BYTE? 

DO  WHILE  (CCUNT:=COUNT  -1)0255; 

DES T*CHARJ 
ADDR=ADDR  ♦ 1J 

end; 

END  fill; 


/*  * * * * * SCANNER  LITS  ****♦/ 


DECLARE 

LITERAL 

LIT 

'29', 

I NPUT$  STR 

LIT 

,'48', 

PERIOD 

LIT 

'1'. 

R PAR IN 

LIT 

'3\ 

LPARIN 

LIT 

'2', 

INVALID 

LIT 

'a'; 

/*  * * * * 

SCANNER 

TABLES  * * * * */ 
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DECLARE  T0KEN$TA3LE  (*)  BYTE  DATA 

/*  CONTAINS  THE  TOKEN  NUMBER  ONE  LESS  THAN  THE  FIRST 
RESERVED  WORD  FOR  EACH  LENGTH  OF  WORD  */ 
(0,0,3,7,13,29,41,48, 56,60,63) , 


TABLE  (*)  BYTE  DATA ( 'BY ' , 'GO ' , 'I F' , 'TO ' , 'EOF ' , ' ADD ' , 'END ‘ 
, 'I-O'  , 'NOT', 'RUN' , 'CALL' , 'ELSE ', 'EXIT  ' , 'FROM' , 'INTO' 

, 'LESS  ' , 'MOVE'  , 'NEXT', 'OPEN', 'PAGE', 'READ', 'SIZE', 'STOP' 
, 'THRU',  'ZERO'  , 'AFTER',  'CLOSE',  'ENTER' , 'EQUAL  ' , 'ERROR' 

, 'INPUT', 'QUOTE',  'SPACE'  , 'TIMES', 'UNTI L ' , 'US ING ' , 'WR ITE 
, 'ACCEPT', 'BEFORF',  'DELETE'  , 'DIVIDE',  'OUTPUT  ',  'DISPLAY ' 
, 'GREATER'  , 'I NV ALID ' , 'NUMER I C ' , 'PERFORM ', 'REWR I TE ‘ 

, 'ROUNDED', 'SECTION'  .'DIVISION ' , 'MULTIPLY ', 'SENTENCE' 

, 'SUBTRACT', 'ADVANCING' , 'DEPENDING  ', 'PROCEDURE ' 

.'ALPHABETIC')  , 

OFFSET  (11)  ADDRESS  INITIAL 

/*  NUMBER  OF  BYTES  TO  INDEX  INTO  THE  TABLE  FOR 
EACH  LENGTH  */ 

(0, 0,0,8 ,26,36 ,146,176,232,264,291)  , 


WORD$COUNT  (*)  BYTE  DATA 

/*  NUMBER  OF  WORDS  OF  EACH  SIZE  */ 
(0,0,4,6,15,12,5,8,4,3,1)  , 

MAX$ID*LEN  LIT  '12', 

MAX5LEN  LIT  '10', 

ADD $ END  (*)  BYTE  DATA  ('EOF  '), 

LOOKED  BYTE  INITIAL  (0), 

HOLD  BYTE, 

EOFFILLEP  LIT  '1  AH ' , 

BUFFERSEND  ADDRESS  INITIAL  (100H), 

NEXT  BASED  POINTER  BYTE, 

INBUFF  LIT  '80H ' , 

CHAR  BYTE  INITIAL*  ' '), 

ACCUM  (82)  BYTE, 

DISPLAY  (82)  BYTE  INITIAL  (0), 

TOKEN  BYTE?  /*RSTURNED  FROM  SCANNER  */ 


/*  PROCEDURES  USED  3Y  THE  SCANNER  */ 


NEXT$CEAR:  PROCEDURE  BYTE; 

IF  LOOKED  THEN 

do; 

looked-false; 

RETURN  (CHAR  :=HCLD)J 

end; 

IF  (POINTER : “POINTER  + 1)  >=  BUFFER$?ND  THEN 

do; 

IF  NOT  MORE$ I NPUT  THEN 

do; 

BUFFERS END* .MEMORY  » 

POINTER*. ADD$ END* 

end; 

else  pointer*inbuff; 
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end; 

IF  NEXT  * EOFFILLER  THEN 

do; 

BUFFER$END  = . MEMORY; 

POINTER  - .ADD$END; 

end; 

RETURN  (CHARs=NEXT  ); 

end  next$char; 

GETACEAR:  PROCEDURE; 

/*  THIS  PROCEDURE  IS  CALLED  WHEN  A NEW  CHAR  IS  NEEDED 
WITHOUT  THE  DIRECT  RETURN  OF  THE  CHARACTER*/ 

char=next$char; 
end  get$char; 

DISPLAT$LINE:  PROCEDURE; 

IF  NOT  LI ST$ I NPUT  THEN  RETURN; 

DISPLAY (DISPLAY (0)  + 1)  = '$'? 

CALL  PRINT ( .DISPLAY ( 1 ) ) * 

DISPLA Y( 0 )=0  ; 

END  displayuine; 

LOAD$DISPLAY : PROCEDURE; 

IF  DISPLAY ( 0 )<S0  THEN 

DISPLAY  (DISPLAYS)  : = D ISPLAY  (0  ) +1  )=CHAR? 

call  getacear; 

END  LOAD^DISPLAYJ 

PUT:  procedure; 

IF  ACCUM( 0 ) < 80  THEN 

ACCUM( ACCUM(0) :=ACCUM(0)+1)=CHAR; 

CALL  lcad$dis?lay; 
end  put; 


EAT$LI NE : PROCEDURE; 

DO  WHILE  CHAROCRJ 

call  load$display; 

'END; 

END  eat$line; 

GET$NO*BLANI:  PROCEDURE? 

DECLARE  (N,I  ) BYTE? 

DO  FOREVER? 

IF  CHAR  = ' ' THEN  CALL  LOAD$DIS PLAY? 
ELSE 

IF  CHAR=C R THEN 

do; 

CALL  displaysline; 

CALL  PRlNTiEflROR(TRUE); 

IF  SECS'iUM  TFEN  N*8J  ELSE  N*2J 
DO  I = 1 TO  n; 

call  lcadadisplay; 
end; 

IF  CHAR  - THEN  CALL  EAT$LINE? 
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end; 

ELSE 

I?  CHAR  = ':'  THEN 

do; 

IF  NCT  DEBUGGING  THEN  CALL  EAT$LINE* 

ELSE 

CALL  load$displat; 
end; 

ELSE 

return; 

end;  /*  END  CF  DO  FOREVER  */ 

END  GET$NO$BLANKJ 

SPACE:  PROCEDURE  BYTE; 

RETURN  (CHAR*'  ')  OR  (CHAR=CR)J 
END  space; 

LEFT$PARIN:  PROCEDURE  BYTE; 

RETURN  CHAR  = 

END  left$parin; 

RIGHT$PARIN : PROCEDURE  BYTE; 

RETURN  CHAR  = ')'; 

END  right$parin; 

DELIMITER:  PROCEDURE  BYTE; 

/*  CHECKS  FOR  A PERIOD  FOLLOWED  BY  A SPACE  OR  CR*/ 

IF  CHAR  <>  THEN  RETURN  FALSE; 

hold*next$char; 

locked=true; 

IF  SPACE  THEN 

do; 

CHAR  = 

RETURN  TRUE? 

end; 

CHAR*'.  '; 

RETURN  FALSE; 

end  delimiter; 

END$OF$TOKEN : PROCEDURE  BYTE; 

RETURN  SPACE  OR  DELIMITER  OR  LEFT$?ARIN  OR  RIGHT$PARIN,* 
END  end$of$token; 

GET5LITERAL:  PROCEDURE  3YTE5 

call  load$display; 
do  forever; 

IF  CHAR  = QUOTE  THEN 

do; 

call  load$display; 

RETURN  LITERAL; 

end; 

CALL  put; 
end; 

end  get$literal; 
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LOOK$UP:  PROCEDURE  BYTE J 
DECLARE  POINT  ADDRESS, 

HERS  BASED  POINT  (1)  BYTE,  I BYTE; 

HATCH:  PROCEDURE  BYTE; 

DECLARE  J BYTE? 

DO  J = 1 TO  ACCUM(0); 

IF  HERE ( J - 1)  <>  ACCUM(J)  THEN  RETURN  FALSE; 

end; 

RETURN  TRUE; 

end  match; 

POINT*OFFSET lACCUM(0) )+  .TABLE; 

DO  1=1  TO  WOR,£$COUNT(ACCUM(0)); 

IF  MATCH  THEN  RETURN  IJ 
POINT  = PCINT  ♦ ACCUM'0); 

end; 

RETURN  FALSE,* 

END  LOOK$UPJ 

RESERVED$WORL : PROCEDURE  BYTE? 

/*  RETURNS  THE  TOKEN  NUMBER  OF  A RESERVED  WORD  IF  THE 
CONTENTS  OF  THE  ACCUMULATOR  IS  A RESERVED  WORD, 
OTHERWISE  RETURNS  ZERO  */ 

DECLARE  VALUE  BYTE; 

DECLARE  NUMB  BYTE; 

IF  A CCUM( 0 ) <=  MAXiLSN  THEN 

do; 

IF  ( NUMB : =TOKSN$TAELE( ACCUM( 0 ) ) ) <>0  THEN 

do; 

IF  ( VALUE: =LOOK$U?)  <>  0 THEN 
NUMB=NUMB  + VALUE; 

ELSE  NUMB=0J 

end; 

end; 

ELSE  NUMB=0; 

RETURN  NUMB; 

end  reservedsword; 

GETSTOKEN:  PROCEDURE  BYTE; 

ACCUM(0)=0; 

CALL  get$no$blank; 

IF  CFAR=OUOTE  THEN  RETURN  GET$LITERAL5 
IF  DELIMITER  THEN 

do; 

CALL  put; 

RETURN  PERIOD; 

end; 

I?  LEFT$PARI N THEN 

do; 

CALL  put; 

RETURN  LPARINJ 

end; 


IF  RIGHT*PARIN  THEN 

do; 

CALL  put; 

RETURN  RPAPINJ 

end; 

do  forever; 
call  put; 

IF  END$OF*TOKEN  THEN  RETURN  INPUT$STR; 

END;  /*  OF  DC  FOREVER  */ 

END  SET* TOKEN,* 

/*  END  OF  SCANNER  ROUTINES  */ 

/*  SCANNER  EXEC  */ 

SCANNER:  PROCEDURE; 

IF( TOKEN :=GST$ TOKEN ) = INPUT$STR  THEN 

IF  ( CTR :=RESERVED$WORD ) <>  0 THEN  TOXEN=CTr; 

END  scanner; 

?RINT$ACCUM:  PROCEDURE; 

ACCUM(ACCUM(0)+1)='*'; 

CALL  PRINT ( . ACCUM(l)); 

END  PRI N T*ACCUMJ 
?RINT*NUM3ER:  PROCEDURE (NUMB ) ; 

DECLARE ( NUMB  , I , CNT ,K ) BYTE,  J (*)  BYTE  D ATA ( 120,10); 
DO  1=0  TO  i; 

CNT=0? 

DO  WHILE  NUMB  >=  (K:«J (I) )? 

NUMB=NUMB  - KJ 
CNT=CNT  + lj 

end; 

CALL  PRI NTCFAR(  '0 ' + CNT); 

end; 

CALL  PRINTCH  A?.  ( '0 ' + NUMB); 

END  print$numbsr; 

/*  * * * END  CF  SCANNER  PROCEDURES  * * * */ 
/*«***  SYMBOL  TABLE  DECLARATIONS  * * * */ 

DECLARE 

CUR$SYM  ADDRESS,  /*SYM30L  BEING  ACCESSED*/ 

SYMBOL  3 AS ED  CUR$SYM  (1)  BYTE, 

SYMBOL$ADDR  BASED  CUR$SYM  (1)  ADDRESS, 
NSXT*SYM$ENTRY  BASED  NEXT$SYM  ADDRESS, 

HASH*MASK  LIT  '3FH ' , 

S*TYPE  LIT  '2', 

DISPLACEMENT  LIT  '13', 

OCCURS  LIT  '12', 

PtLENGTH  LIT  '3', 

FLD$LENGTH  LIT  '3', 

LEVEL  LIT  '10', 

DECIMAL  LIT  '11', 


OCCURS 

PtLENGTH 

FLD$LENGTH 

LEVEL 

DECIMAL 

REL$ID 

LOCATION 

START$NAME 

FCB$ADDR 


LIT 

LIT 

LIT 

LIT 

LIT 

LIT 

LIT 

LIT 

LIT 


1 1/  AJ  JL  A J 1 

LOCATION  LIT  '2  , 

START$NAME  LIT  '12',  /*1  LESS*/ 

FCB$ADDR  LIT  '4', 

/**#*«**  SYMBOL  TYPE  LITERALS  *******/ 
UNRESOLVED  LIT  '255', 

LABEL*TYPE  LIT  '32', 
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MULT$OCCURS  LIT 
GROUP  LIT 

NO N$ NUMERICAL IT  LIT 
ALPHA  LIT 

ALPHA$NUM  LIT 

LITSSPACE  LIT 

LIT$QUCTE  LIT 

LIT$ZERO  LIT 

NUMERICS LITERAL  LIT 
NUMERIC  LIT 

COMP  LIT 


6', 


'10 

'11 

'12 

'16' 

21', 


f 


t 


A$ED  LIT  '72', 

A$N*ED  LIT  '73', 

NUMBED  LIT  '80'J 

/*  * * * SYMBOL  TABLE  ROUTINES  * * * */ 
SET$ADBRESS:  PROCEDURE! ADDR  ) ? 

DECLARE  ADDR  ADDFESS  J 

SYMBOL$ADDR( LOCATION )*ADDR; 

END  SBTSADDRESS? 


GETSADDitESS  : PROCEDURE  ADDRESS; 

RETURN  SYMBOLS ADDR (LOCATION  ) ; 
END  GETS  ADDRESS ; 

GETSFCBS ADDR:  PROCEDURE  ADDRESS! 


RETURN  SYMBOL$ADDR(FCB$ADDR) J 
END  GETSFCBSADDR; 

GETSTYPE : PROCEDURE  BYTE? 

RETURN  SYMBOL! SSTYPE) ; 

END  getstype; 

SSTSTYPE:  PROCEDURE ( TYPE) J 


DECLARE  TYPE  BYTE; 

SYM3CL(SSTTPE)=TYPE; 

END  SETSTYPEJ 

GETSLENGTH:  PROCEDURE  ADDRESS; 

RETURN  SYMBCL$ADDR(FLDSLENGT5) J 
END  getslength; 

GET^LEVEL:  PROCEDURE  BYTE? 

RETURN  SYMBOL(LEVEL); 

END  getSlevel; 

GETSDECI MAL:  PROCEDURE  BYTE; 

RETURN  SYMBOL!  DECIMAL),* 

end  getSdecimal; 

GETSPSLENGTH:  PROCEDURE  BYTE; 

RETURN  SYMBOL! P$LENGTH) ; 

END  getSpSlength; 

BUI LDSSYMBOL  : PROCEDURE  ( L SN  ) ; 

DECLARE  LEN  BYTE,  TEMP  ADDRESS; 
temp»nextSsym; 

IF  ( NEXTS STM :* .SYMBOL (LEN :*LEN  ♦ DISPLACEMENT)) 
> MAXSMEMORY  TEEN  CALL  FATALSERROR ! 'ST ' ) ; 
CALL  FILL  ( TEMP,  0, LEN  ),* 

END  BUILDSSYMBOL; 

ANDSOUTSOCCURS  : PROCEDURE  (TYPESIN)  BYTE? 

DECLARE  TYPESIN  BYTE? 

RETURN  TYPE$ IN  AND  127; 
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END  AND$OUT$OCCURS » 

/*  * * * PARSEP  DECLARATIONS  * * * */ 

DECLARE 

PSTACKSIZE  LIT  '30%  /*  SIZE  OF  PARSE  STACKS*/ 

VALUE  (PSTACKSIZE)  ADDRESS,  /*  TEMP  VALUES  */ 
STATESTACK  (PSTACKSIZE)  BYTE,  /*  SAVED  STATES  */ 

VALUE2  (PSTACKSIZE)  ADDRESS,  /*  VALUE2  STACK*/ 

VARC  (100)  BYTE,  /*TEMP  CHAR  STORE*/ 

ID$STACK  (20)  ADDRESS, 

ID$PTR  BYTE, 

MAX$BYTE  BASED  MAX$ I NT$MEM  BYTE, 

SUB$I ND  BYTE  INITIAL  (0), 

COND$TYPE  BYTE, 

HOLDtSECTION  ADDRESS, 

HOLD$SEC$ ADDR  ADDRESS, 

SECTION$FLAG  BYTE  INITIAL  (0), 

L$ADDR  ADDRESS, 

DISPLAY$FLAG  BYTE  INITIAL  (FALSE), 

LiLENGTH  ADDRESS, 

L$TYPS  BYTE, 

L$DEC  EYTE , 

CON$LENGTH  BYTE, 

COMPILING  BYTE  IN ITI AL ( TRUE  ) , 

SP  BYTE  INITIAL  (255), 

MP  BYTE, 

MPP1  BYTE, 

NOLOOK  BYTE  I NITIAL (FALSE  ) , 

( I , J,K)  BYTE,  /*I NDIC IES  FOR  THE  PARSER*/ 

STATE  BYTE  INITIAL (STARTS  ) , 

/**♦*♦***  CODE  LITERALS  *****#♦*♦*/ 

/*  THE  CODE  LITERALS  ARE  BROKEN  INTO  GROUPS  DEPENDING 
ON  THE  TOTAL  LENGTH  OF  CODE  PRODUCED  FOR  THAT  ACTION  */ 


/*  LENGTH  ONE  */ 


ADD  LIT 
SUB  LIT 
MUL  LIT 
DIV  LIT 

NEG  LIT 
ST?  LIT 
STI  LIT 


'1' 

'2' 

'3' 

'4' 

'5' 

'6' 

'7' 


/*  LENGTH  TWO  */ 


RND  LIT  '8' 


REGISTER  0 */ 

1 FROM  REGISTER  0 */ 

1 */ 


/*  ADD  REGISTER  1 TO 
/*  SUBTRACT  REGISTER 
/*  MULTIPLY  REGISTER  0 BY  REGISTER 
/*  DIVIDE  REGISTER  0 BY  REGISTER  1 
(NO  REMAINDER)  */ 

/*  NOT  OPERATOR  */ 

/*  STOP  PROGRAM  */ 

/*  STORE  REGISTER  2 


INTO  REGISTER  0 */ 


/*  ROUND  CONTENTS  OF  REGISTER  2 */ 


/*  LENGTH  THREE  */ 


RET 

LIT 

'9'j 

/* 

RETURN  */ 

CLS 

LIT 

'10  , 

/* 

CLOSE  */ 

SER 

LIT 

'11  . 

/* 

BRANCH  ON  SIZE  ERROR 

*/ 

BRN 

LIT 

'12% 

/* 

BRANCH  */ 

OPN 

LIT 

'13  . 

/* 

OPEN  A FILE  FOR  INPUT 

*/ 

OP1 

LIT 

'14', 

/* 

OPEN  A FILE  FOR  OUTPUT  */ 

0P2 

LIT 

'15% 

/* 

OPEN  A FILE  FOR  BOTH 

INPUT 

RGT 

LIT 

'16', 

/* 

REGISTER  GREATER  THAN 

*/ 

RLT 

LIT 

'17'. 

/* 

REGISTER  LESS  THAN  */ 

REO 

LIT 

'18% 

/* 

REGISTER  EQUAL  */ 

INV 

LIT 

'19', 

/’"BRANCH  IF  INVALID-FILE-ACTION  FLAG  TRUE*/ 

EOR 

LIT 

'20', 

/* 

BRANCH  ON  END-OF-PECORDS  FLAG  */ 

/*  LENGTH 

FOUR  */ 

ACC 

LIT 

'21', 

/* 

ACCEPT  */ 

STD 

LIT 

'22', 

/* 

STOP  WITH  DISPLAY  */ 

LDI 

LIT 

'23'. 

/* 

LOAD  A CODE  ADDRESS  DIRECT  */ 

/*  LENGTH 

FIVE  */ 

DIS 

LIT 

24', 

/* 

DISPLAY  */ 

DEC 

LIT 

'25', 

/* 

DECREMENT  COUNT  AND  BRANCH  IF  ZERO  * 

/ 

STO 

LIT 

'26', 

/* 

STORE  NUMERIC  */ 

1 

ST1 

LIT 

'27'. 

/* 

STORE  SIGNED  NUMEPIC  LEADING  */ 

4 

ST2 

LIT 

'28', 

/* 

STORE  SIGNED  NUMERIC  TRAILING  */ 

1 

ST3 

LIT 

'29', 

/* 

STORE  SEPARATE  SIGN  LEADING  */ 

j| 

ST4 

LIT 

'30', 

/* 

STORE  SEPARATE  SIGN  TRAILING  */ 

B 

ST5 

LIT 

'31 ', 

/* 

STORE  K PACKED  NUMERIC  FIELD  */ 

/*  LENGTH 

SIX 

*/ 

i 

LOD 

LIT 

'32', 

/* 

LOAD  NUMEPIC  LITERAL  */ 

i 

LDI 

LIT 

'33', 

/* 

LOAD  NUMERIC  */ 

i 

i 

LD2 

LIT 

'34', 

/* 

LOAD  SIGNED  NUMERIC  LEADING  */ 

LD3 

LIT 

'35', 

/* 

LOAD  SIGNED  NUMERIC  TRAILING  */ 

LD4 

LIT 

'36', 

/* 

LOAD  SEPARATE  SIGN  LEADING  */ 

I 

LD5 

LIT 

'37', 

/* 

LOAD  SEPARATE  SIGN  TRAILING  */ 

1 

LD6 

LIT 

'38', 

/* 

LOAD  A PACKED  NUMERIC  FIELD  */ 

/*  LENGTH 

SEVEN  */ 

PER 

LIT 

'39', 

/* 

PERFORM  */ 

CNU 

LIT 

'40', 

/* 

COMPARE  NUMEPIC  UNSIGNED  */ 

CNS 

LIT 

'41;, 

/* 

COMPARE  NUMERIC  SIGNED  */ 

CAL 

LIT 

'42', 

/* 

COMPARE  ALPHABETIC  */ 

RWS 

LIT 

'43', 

/* 

REWRITE  SEQUENTIAL  */ 

DLS 

LIT 

'44;, 

/* 

DELETE  SEQUENTIAL  */ 

RDF 

LIT 

45', 

/* 

READ  A SEQUENTIAL  FILE  */ 

WTF 

LIT 

'46', 

/* 

WRITE  A RECORD  TO  A SEQUENTIAL  FILE 

*/ 

RVL 

LIT 

'47', 

/* 

READ  A VARIABLE  LENGTH  FILE  */ 

WVL 

LIT 

'48', 

/* 

WRITE  A VARIABLE  LENGTH  RECORD  */ 

/*  LENGTH 

NINE  */ 

| 

SCR 

LIT 

'49' , 

/* 

CALCULATE  A SUBSCRIPT  */ 

,! 

SGT 

LIT 

'50  ', 

/* 

STRING  GREATER  THAN  */ 

SLT 

LIT 

'51', 

/* 

STRING  LESS  THAN  */ 

• I 

jEQ 

LIT 

'52', 

/* 

STRING  EQUAL  */ 

' 

j 

mov 

LIT 

'53' , 

/* 

MOVE  */ 

i 

/*  LENGTH 

TEN 

*/ 

RRS 

LIT 

'54;, 

/* 

READ  RELATIVE  SEQUENTIAL  */ 

WRS 

LIT 

'55', 

/* 

WRITE  RELATIVE  SEQUENTIAL  */ 

RRR 

LIT 

'56', 

/* 

®EAD  RELATIVE  RANDOM  */ 

WRR 

LIT 

'57', 

/* 

WRITE  RELATIVE  RANDOM  */ 

RWR 

LIT 

'58', 

/* 

REWRITE  RELATIVE  */ 

DLR 

LIT 

'59', 

/* 

DELETE  RELATIVE  */ 

/*  LENGTH 

ELEVEN  */ 

MED 

LIT 

'60  , 

/♦MOVE  INTO  AN  ALPHANUMERIC  EDITED  FIELD*/ 

MNE 

LIT 

'61'. 

/* 

MOVE  INTO  A NUMERIC  EDITED  FIELD  */ 

/*  VARIABLE  LENGTH  */ 

GDP 

LIT 

'62  , 

/* 

GO  TO  - DEPENDING  ON  */ 

l 

/*  BUILD  DIRECTING  ONLT  */ 

l 

INT 

LIT 

'63', 

/* 

INITIALIZE  MEMORY  */ 

206 
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I 
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BST 

LIT 

64', 

/* 

BACK  STUFF 

*/ 

TER 

LIT 

'65', 

/* 

TERMINATE 

BUILD  */ 

SCD 

LIT 

'66'; 

/* 

START  CODE 

*/ 

/*  * * * PARSER  ROUTINES  ****♦/ 
DIGIT:  PROCEDURE  (CHAR)  BYTE? 


DECLARE  CHAR  BYTE; 

RETURN  (CRAR<='9')  AND  (CHAR>='0'){ 

END  digit; 

LETTER:  PROCEDURE  (CHAR)  BYTE; 

DECLARE  CHAR  BYTE; 

RETURN  ( CHAR  >= 'A  ' ) AND  (CHAR<='Z')? 

END  letter; 

INVALIDS TYPE:  PROCEDURE? 

CALL  PP.INT$ERROR(  'IT'  )J 
END  INVALIDSTYPE? 

3YTES0UT:  PROCEDURS(ONESBYTE) ? 

DECLARE  ONES BYTE  BYTE; 

IF  (OUTPUTS  PTR : “OUTPUTS PTR  + 1)  > OUTPUTSEND  THEN 

do; 

CALL  WRITESOUTPUT(  .GUTPUTSBUFF)  ? 

OUTPUT$PTR= .OUTPUTSBUFF; 

end; 

OUTPUT schar=onesbyte; 
end  bytesout; 

ADDR$CUT : PROCEDURE  (ADER)J 
DECLARE  A DDR  ADDRESS? 

CALL  BYTE$CUT(LOV(ADDR) ) J 
CALL  BYTESOUT (HIGH  (ADDH))? 

END  ADDRSOUT? 

INC$COUNT:  PROCEDURE( CNT) ; 

DECLARE  CNT  BYTE* 

I F( NEXTS AVAILABLE: =NEXTS AVAILABLE  ♦ CNT) 

>MAX$INTSMEM  THEN  CALL  FATAL$ERROR( 'MO' ) J 
END  INCSCOUNT? 

ONE$ADDR$OPP:  PROCSDURE( CODE, ADDR ) ? 

DECLARE  CODE  BYTE,  ADDR  ADDRESS? 

CALL  BYTESOUT (CODE ) ? 

CALL  ADDPSOUT(ADDR) ? 

CALL  INCSC0UNT(3) ? 

END  ONES ADDRSOPP? 

NOTS I MPL I MINTED : PROCEDURE; 

CALL  PRINT$ERR0R  ( 'NI  ') ; 

END  notsimplimzntsd; 

MATCH:  PROCEDURE  ADDRESS? 

/*  CHECKS  AN  IDENTIFIER  TO  SEE  IF  IT  IS  IN  THE  SYMBOL 
TABLE.  IF  IT  IS  PRESENT,  CURSSYM  IS  SET  FOR  ACCESS, 
OTHERWISE  THE  POINTERS  ARE  SET  FOR  ENTRY*/ 

DECLARE  POINT  ADDRESS,  COLLISION  BASED  POINT  ADDRESS, 
(HOLD, I)  BYTE? 

IF  VARC(0)>MAXSIDSLEN  THEN  VARC ( 0 )*MAX$ ID$LEN ? 

HOLD=0  ? 

DO  1=1  TO  VARC(0)? 

HOLD=HOLD+VARC(I); 

end; 
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POI NT=HASH$T AB$ADDR  + SHL ( ( HOLD  AND  HASH$MASK ) , 1 ) » 

DO  FOREVER? 

IF  COLLIS ION=0  THEN 

do; 

cur$sym  ,collision=next$sym; 

CALL  BUILD$SYMBOL( 7ARC ( 0) ) ? 

SYMBOL ( P$ LENGTH )=V ARC (0  ) ; 

DO  1=1  TO  VARC(0); 

SYMBOL ( START$  NAME+I  )=VARC(I )? 

end; 

CALL  SET^TYPE (UNRESOLVED) J /*  UNRESOLVED  LABEL  */ 
RETURN  CUP.SSYM? 

end; 

ELSE 

do; 

cur$sym=collision; 

IF  (HCLD:=GET$P$LENGTH)=VA?.C(0)  THEN 

do; 

1*1 ; 

DO  WHILE  SYMBOL( START $NAME  + I )=  VARC(I); 

IF  ( I : = I+1 )>HOLD  THEN  RETURN ( CURiSYM : = CCLLIS ION ) 
END; 

end; 

end; 

pcint=collision; 

end; 

end  match; 

SET$VALUE:  PROCEDURE ( NUMB  ) ; 

DECLARE  NUMB  ADDRESS? 

VALUE (MP)=NUMBJ 

END  set$value; 

SSTSVALUE2:  PRCCEDURE(ADDR ) J 
DECLARE  A DDR  ADDRESS,* 

value2(mp)=addr; 

END  S ET$ VALUE2 ? 

SUBtCNT:  PROCEDURE  BYTE ; 

IF  (SUB$IND:=SUB$IND  + 1 ) >8  THEN 
SU3ilND=l ; 

RETURN  SUB$INDJ 
END  sub$cnt; 

CODEABYTE;  PROCEDURE  (CODE); 

DECLARE  CODE  BYTE? 

CALL  BYTE$OUT(CODE) ; 

CALL  INC$C0UNT(1); 

END  CODE<BYTEJ 

CODE$ ADDRESS : PROCEDURE  (CODE); 

DECLARE  CODE  ADDRESS? 

CALL  ADDRiOUT ( CODE ) ? 

CALL  INC$C0UNT(2); 

END  CODESADDRESS? 

INPUT$NUMERIC:  PROCEDURE  BYTE? 

DO  CTR=1  TO  VARC(0); 

IF  NOT  DIGIT ( VARC ( CTR ) ) THEN  RETURN  FALSE? 

END? 
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RETURN  TP.DE* 

END  INPUTSNUMERIC? 

CONVERTS  INTEGER : PROCEDURE  ADDRESS? 

ACTR=0? 

DO  CTR*1  TO  VARC(0)? 

IF  NOT  DIGIT(VAP.C(CTR)  ) THEN  CALL  PR  I NT  TERROR  ( 'NN ' ) ? 
A$CT?=SHL(ACTR,3)+SHL( ACTR.l)  + VARC(CTR)  - '0'? 

END? 

RETURN  ACTR  ? 

END  CONVEPT$I NTEGEB? 

BACKSTUFF:  PROCEDURE  (ADD1.ADD2)? 

DECLARE  (ADD1.ADD2)  ADDRESS? 

CALL  BYTE$OUT(BST)  ? 

CALL  ADDR$OUT( ADD1 ) ? 

CALL  ADDR$OUT( ADD2  ) ? 

END  3ACK$STUFF ? 

UNRESOLVED^ BRANCH:  PROCEDURE? 

CALL  S ETS VALUE ( NEXT $ AVAILABLE  + 1)? 

CALL  ONES ADDR $OP?( BRN  ,0) ? 

CALL  SET$VALUS2(NEXT$ AVAILABLE) ? 

END  UNRES0LVED$3RANCH? 

BACK$COND:  PROCEDURE? 

CALL  BACKSTUFF ( VALUE ( SP-1 ) ,NEXT$AVAILA3LE) ? 

END  BACKSCOND? 

SET$BRANCH : PROCEDURE? 

CALL  SETSVALUE(NSXTSAVAILABLE) ? 

CALL  CODES  ADDRESS ( 0 ) ? 

END  SETSBRANCH? 

KEEPSVALUES : PROCEDURE? 

CALL  SET$VALUE(VALUE(SP) ) ? 

CALL  S ETS  V ALUE2 ( VALUE2( S P ) ) ? 

END  KEEPSVALUES? 

GETSRECS ADDRESS  : ?ROCEDURE( RECORDS ADDR ) ADDRESS? 

DECLARE  (RECORDSADDR,  HOLD$ ADD? ) ADDRESS? 
CUR$STM=RECORD$ADDR? 

HOLDS A DDR=GETS ADDRESS ? 

CURSsYP*GETS?CBS ADDR? 

RETURN  HOLDS  ADDR ? 

END  GETSRSCSADDRESS? 

GETSRBCSLEN:  P?OCEDURE( RECORDSADDR ) ADDRESS? 

DECLARE  (RECCRDSADDR,  HOLDSLENGTH)  ADDRESS? 

CURSSY*!=R SCORES  ADDR  ? 

HOLD$LENGTH»GETSLSNGTH? 

CURSSYM*G ETS FCBS ADDR? 

RETURN  HOLDSLENGTH? 

END  GETSRECSLEN? 

STDSATTR IBUTES  : PROCSDURE( TYPE) ? 

DECLARE  TYPE  BYTE? 

CALL  CODE* ADDRESS (GETSFCBS ADDR ) ? 

CALL  CODE$ADDRESS ( GETSRECSADDRESS ( GETS  ADDRESS ) ) ? 

CALL  COrE$ ADDRESS ( GETSRECSLEN (GETS  ADDRESS ) )? 

IF  TYPE*0  THEN  RETURN? 

CUR$SYM=SYMBOL$ADDR( REL$ID ) ? 

CALL  CODESADDRESS (GET$ADDRESS ) ? 
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CALL  CODE$BTTE(GET$LENGTH); 

END  STD$ ATTRIBUTES » 

WR I TE$A$ RECORD  : PROCEDURE; 

IF  getaleveloi  THEN  CALL  PRINT$ERR0R( 'WL'); 

ELS  E DO ; 

cur$stm*get$fcb$addr; 

IF  (CT?:*GET$TTPE)*1  THEN 

do; 

CALL  CODE$BTTE(WTF) ; 

CALL  STD$ATTRIBUTES(Z); 

END; 

ELSE  IF  CTR=2  THEN 

do; 

CALL  CODE$BTTE(WRS) J 
CALL  STD$ATTRIBUTES(1); 

end; 

ELSE  IF  CTR-3  THEN 

do; 

CALL  CODE$BTTE(WRR) J 
CALL  STD$ATTRIBUTES(1 ) ; 

end; 

ELSE  IF  CTR-4  THEN 

do; 

CALL  CODE*BTTE(VVL) J 
CALL  STDi ATTRIBUTES ( 0 ) » 

END; 

ELSE  CALL  FR I NT$SRR0R ( 'FT  ' ) 5 

end; 

END  ¥RITS$A$RECORD; 

R2AP$A$FILE : PROCEDURE; 

IF  ( CTR:-GET$TYPE)=1  THEN 

do; 

CALL  CCDE$3TTE(RDF) ; 

CALL  STD$ ATTRIBUTES ( 0 ) J 

end; 

ELSE  IF  CTR-2  THEN 

do; 

CALL  CODE$BTTE(RRS) ; 

CALL  STD$ATTR I3UTES (1)5 

end; 

ELSE  IF  CTR-3  THEN 

do; 

CALL  CODE$BTTE( RRR) J 
CALL  STD$ ATTRIBUTES (1 ) ; 

end; 

ELSE  I?  CTR-4  THEN 

do; 

CALL  CODS$BTTE(RVL); 

CALL  STD$ ATTRIBUTES (0)1 

end; 

ELSE  CALL  PR INT$ERR0R ( 'FT  ' ) ; 

END  read*a*file; 

ARITHWETICATTPE:  PROCEDURE  BYTE,* 

IF  ( (L$TYPE:»ANDiOUT$OCCURS(L$TYPS)  )>*NUMERICUITERAL) 


AND  (LATYPEOCOMP)  THEN  RETURN  LATYPE  - NUMERIC^ LITERAL; 

CALL  invalidatype; 
return  0; 

END  arithmeticAtype; 

DELETEAAAFILE:  PROCEDURE; 

IF  ( CTR ;*GET$TYPE )=3  THEN 

do; 

CALL  CODE$BYTE(DLR) J 
CALL  STD A ATTRIBUTES ( 1 ) » 

end; 

ELSE  IF  CTR-2  THEN 

do; 

CALL  CODEARYTE(DLS) J 
CALL  STDAATTRIBUTES  (0 ) ,* 

end; 

ELSE  CALL  PP INTAERROR ( 'IT  ' ) ; 

END  DELETEAAAFILE; 

rewriteaaarscord:  procedure; 

IF  GET  ALE7EL01  THEN  CALL  PRlNTAERROR ( 'WL ' ) ; 

ELSE  do; 

curasym=getafcbaaddr; 

IF  ( CTR:=GETATY?E)*3  THEN 

do; 

CALL  CODEABTTE (RVR) ; 

CALL  STDAATTRI3UTES( 1); 

end; 

ELSE  IF  CTR=2  THEN 

do; 

CALL  CODEABTTE (RWS); 

CALL  STDAATTRI3UTES(0); 

end; 

ELSE  CALL  PRlNTASRROR( 'IT' ) ; 

end; 

END  REWRITSAaARSCORD; 

ATTRIBUTES:  PROCEDURE; 

CALL  CODEAADDRESS(LAADDR) ; 

CALL  CODEABTTE(LALENGTH); 

CALL  CODEABTTE ( LADEC ) J 

END  attributes; 

LOADALAID:  PROCEDURE (SAPTR) ; 

DECLARE  SAPTR  BYTE? 

IF  ((AACTR  :*  VALUE(SAPTR) ) <=  NONANUMER ICALIT ) OR 
( ACTR  * NUMERICALITERAL)  THEN 

do; 

LAADDR-VALUE2(S?TR); 

lAlsng?e*conalength; 

l$type*aactr; 

return; 

end; 

IF  AAC  TR<*LI T A ZERO  THEN 

do; 

latype.lAaddr-aActr; 

L$LENGTH-i; 

return; 
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_____ 


end; 

CUR$SYM=VALUE(S$PTR); 

l$type*get$type; 

L$LENGTH=GETiLENGTH; 

L$DEC=GET$ DECIMAL! 

I F ( L$ADDR : =VALUE2( S$?TR ) ) =0  THEN  L$ADDR*GET$ ADDRESS ; 

END  load$l$id; 

LOAD$REG:  PROCEDURE( REG$NO, PTR) » 

DECLARE  ( REG$NO , PTR ) BYTE! 

CALL  LOAD$L$ID(PTR); 

CALL  C0DE$9YTE(L0D+ARITHMETIC$TYPE); 

CALL  ATTRIBUTES; 

CALL  CODE$BYTE( REG$NO ); 

END  LOADiREG; 

STORE$REG : PROCEDURE ( PTR ) J 
DECLARE  PTR  BYTE; 

CALL  LOAD$L$ID(PTR); 

CALL  CODE$BYTE( STO  ♦ ARITHMETICSTYPE  -1); 

CALL  attributes; 

END  STOREiP.EG » 

STORE$CONSTANT:  PROCEDURE  ADDRESS; 

IF(MAX$INT$MEM:=MAX$INT$MEM  - VARC ( 0 ) )<NSXT$ AVAILABLE 
THEN  CALL  FATAL$ERROR( 'MO  ' ) J 
CALL  BYTE$0UT(INT)  5 
CALL  ADDR$OUT(MAXilNT$MEM)J 
CALL  ADDRiOUT( CON$LENGTE:=VARC ( 0 ) )? 

DC  CTR  = 1 TC  con$length; 

CALL  BYTE$OUT(VARC(CTR))? 

end; 

RETURN  MAX$INT$MEM? 

end  store$constant; 

NUMERIC$LIT : PROCEDURE  BYTE? 

DECLARE  CHAR  BYTE; 

DO  CTR=1  TO  YARC(0); 

IT  NOT ( D IGI T( CHAR := VARC ( CTR ) ) 

OR  (CHAR= ) OR  (CHAR-'O 
OR  (CHAR*'.'))  THEN  RETURN  FALSE! 

end; 

RETURN  TRUE; 

end  numericuit; 

ALPHA$LIT:  PROCEDURE  BYTE! 

DO  CTR-1  TO  VARC (0  ) J 

IF  NOT (LETTER (VARC (CTR  ) ) ) THEN  RETURN  FALSE! 

end; 

RETURN  TRUE; 

END  alpha$lit; 

ROUND$STORE:  PROCEDURE! 

IF  VALUE(SP)<>0  THEN 

do; 

CALL  CODE$BYTE( RND  ) » 

CALL  CODE$BYTE(L$DEC); 

end; 

CALL  S TORE i REG ( SP-1 ) ; 

END  ROUND$STOREJ 


ADDSSUB:  PROCEDURE  (INDEX); 

DECLARE  INDEX  BYTE? 

CALL  LOAD$REG(0,MPP1) ; 

IF  VALUE ( SP-3 )<>0  THEN 

do; 

CALL  L0ADSREG(l,SP-3); 

CALL  CODE$BYTE( ADD) ? 

CALL  CODE$BYTE( STI ) » 

end; 

CALL  LOADS REG ( 1 ,SP-1 ) ; 

CALL  CODE$BYTE( ADD  + INDEX); 

CALL  ROUND$STORS; 

END  addssub; 

MULTSDIV:  PROCEDURE( INDEX ) ; 

DECLARE  INDEX  BYTE; 

CALL  LOAD$REG(0,MPP1) J 
CALL  loadsregu.sp-i)  ; 

CALL  CODESBYTE ( MUL  + INDEX); 

CALL  roundsstore; 

END  MULTSDIV? 

CHECKSSUBSCRIPT:  PROCEDURE,* 

CUR$SYM*VALUE(MP); 

IF  GET  $ TYPE <MULT$ OCCURS  THEN 

do; 

CALL  PR I NTS  ERROR ( 'IS  ') ; 

return; 

end; 

IF  INPUTSNU^ERIC  THEN 

do; 

CALL  SETSVALUE2(GET$ADDRSSS  (GETSLSNGTH  * 
CONVERTSINTEGSR)  ) ; 

return; 

end; 

curSsym=match; 

IF  ( (CTR:=GETSTYPE  XNUMERIC ) OR  (CTR>COMP)  THEN 
CALL  PRINTSERR0R( 'TE'); 

CALL  ONES ADDRSOPP( SCR , GETS ADDR ESS  ) J 
CALL  CODESBYTE(SUBSCNT) ; 

CALL  CODES BYTE ( GETS LENGTH  ) J 
CALL  S ET$ VALUE2 ( SUBS  I ND  ) ? 

END  checkssubscp.ipt; 

LOADSLABEL:  procedure; 

CUR$SYM=VALUE(MP); 

IF  ( ASCTR  :*GET$ADDRESS ) <>0  THEN 

CALL  BACK SS TUFF ( AS CTR , V ALUE2 ( MP ) ) J 
CALL  SETS  ADDRESS (VALUE2(MP) ) ; 

CALL  SETSTYPE(LABELSTYPE) 5 

IF  ( ASCTR :=GETSFCBSADDR)<>0  THEN 

CALL  BACK$STUFF(  ASCTR.NEXTSAVAILABLE),* 

sy*bclsaddr(fcbsaddr)=next$available; 

CALL  ONESADDRSOPP(RET,0); 

END  LOADSLABEL; 

LOADSSECSLABEL:  procedure; 

ASCTR=VALUS(HP); 
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CALL  SET$VALUE(HOLD$SECTION)? 

hold$section=a$ctr; 

A$CTR*VALUE2(MP)? 

CALL  SETS  V ALUE2 ( HOLDSSECSADDR) ? 

HOLDSSECSADDR  = A$CTR ? 

CALL  LOADSLABEL? 

END  LOADSSECSLABEL? 

LABELSADDR$OFFSET:  PROCEDURE  (ADDR,  HOLD,  OFFSET)  ADDRESS 
DECLARE  ADDR  ADDRESS? 

DECLARE  (HOLD,  OFFSET,  CTR)  BYTE? 

cur$sym=addr; 

I F ( CTR  :=GET$TYPE)=*LABELSTYPE  THEN 
DO? 

IF  HOLD  THEN  RETURN  GETS ADDRESS  ? 

RETURN  GET$FC3$ADDR? 

END? 

IF  CTROUNRESOLVED  THEN  CALL  INVALID$TY?E? 

IF  HOLD  THEN 
DO? 

A$CTR=GET$ADDRESS? 

CALL.  SETS  ADDRESS (NEXTS AVAILABLE  ♦ OFFSET)? 

RETURN  A$CTR? 

END? 

ASCTR=GETSFCB$ ADDR  ? 

SY^BOLSADDP(FCBSADDR)*NEXTSAVAILABLE  + OFFSET? 

RETURN  A$CTR? 

END  LABELSADDRSCFFSET? 

LABEL$ADDR:  PROCEDURE  (ADDR,  HOLD)  ADDRESS? 

DECLARE  ADDR  ADDRESS, 

HOLD  BYTE? 

RETURN  LABELSADDRSOFFSET  (ADDR,  HOLD,  1)? 

END  LABELSADDR? 

CODSSFORSDISPLAY : PROCEDURE  (POINT)? 

DECLARE  POINT  BYTE? 

CALL  LOADSLS ID( POINT) ? 

CALL  CNESADDR$OPP( DIS ,LSADDR  ) ? 

CALL  CODESBTTE(L$LENGTH) ? 

IF  DISPLAY$FLAG  THEN  CALL  CODE$BTTE ( 1 ) ? 

ELSE  CALL  CODES3YTE(0 ) ? 

DISPLAYS FLAG=FALSS? 

END  CODESFORSDISPLAY? 

A$AN$TYPE:  PROCEDURE  BYTE? 

RETURN  (LSTYPE=ALPHA)  OR  ( LSTYPE* ALPHASNUM ) ? 

END  A$AN$TYPE? 

NOTSINTEGER:  PROCEDURE  BYTE? 

RETURN  LSDECO0? 

END  NOTSI NTEGER? 

NUMERICSTYPE:  PROCEDURE  BYTE? 

RETURN  ( LSTYPE>=NUPER ICSLITSRAL)  AND  ( L$TYPE<=COMP) ? 

END  NUMERICSTYPE? 

GEN$COMPAREj  PROCEDURE? 

DECLARE  (HSTYPE.HSDEC)  BYTE, 

(H$ADDR,H$LSNGTH)  ADDRESS? 

CALL  LOADSLS ID ( MP ) ? 
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L$TYPE=AND$OUT$ OCCURS (L$TYPE ) » 

IF  C0ND$TYPE=3  THEN  /*  COMPARE  FOP  NUMERIC  */ 

do; 

IF  A$AN$TYPE  OR  (L$TYPE>COMP)  THEN  CALL  INVALI D$TYPE; 
CALL  SET$ VALUE2( NEXT$A  VAILABLE )> 

IF  L$TYPE*NUMERIC  THEN  CALL  CODS$BYTE ( CNU ) » 

ELSE  CALL  C0DE$3YTE( CNS ) i 
CALL  CODE$ ADDRESS ( L$ ADDR ) » 

CALL  CODES ADDRESS ( L$ LENGTH) • 

CALL  SET$ BRANCH! 

end; 

ELSE  IF  COND$TTPE=4  THEN 

do; 

IF  NUMERICSTTPE  THEN  CALL  I NVALID$TY?E; 

CALL  SET$VALUE2(NEXT$AVAILABLE); 

CALL  CODE$BYTE(CAL  )»* 

CALL  CODE$ADDRESS( L$ADDR) J 
CALL  CODS$ADDRESS(L$LENGTH) J 
CALL  SETS  BRANCH; 

end; 

else  do; 

IF  NUMERICSTYPE  THEN  CTR=i; 

ELSE  CTR=0J 

h$ty?e=l$type; 

H$DSC=L$DEC; 

h$addr*l$addr; 

h$length=l$length; 

CALL  LOADSLSlD(SP) ; 

IF  NUMERICSTYPE  THEN  CTF.=CTR+i; 

IF  CTR=2  THEN  /*  NUMERIC  COMPARE  */ 

do; 

CALL  LOADSREG(0,MP) J 

CALL  SET$VALUE2( NEXTSAV AI LABLE-6 ) ! 

CALL  LOAD$REG(l,SP) ; 

CALL  CODE$BYTE(SUB); 

CALL  C0DE$3YTE(RGT  + COND$TYPE)J 
CALL  SETS3RANCH; 

end; 

else  do; 

/*  ALPHA  NUMERIC  COMPARE  */ 

IF  ( HSDECO0 ) OR  (HSTYPS=COMP) 

OR  ( ISDECO0 ) OR  ( L$TYPE=COMP ) 

OR  ( H$LENGTHOL$LENGTH  ) THEN  CALL  INVALID^TTPE  J 
C ALL  SETSVALUS2( NEXT$ AVAILABLE) ? 

CALL  CODESBYTE(SGT+CONDSTYPE); 

CALL  CODE$ADDRSSS(H$ADDR)  ; 

C ALL  CODES  ADDRESS ( L$ADDR) ; 

CALL  CODESADDRESS(H$LENGTH)j 
CALL  SET$3RANCH; 

end; 

end; 

end  genScompare; 

MOVE$TYPE:  PROCEDURE  BYTE; 

DECLARE 

. I : 
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HOLD$TYPE  BYTE, 

ALPHAS  NUM$ MOVE  LIT  '0 ' , 

ASN$ED$MOVE  LIT  'l', 

NUMERI CSMOVE  LIT  ' 2 ', 

N$ED$MOVE  LIT  '3'? 

L $T YPE= A ND$OUT$ OCCURS (L$TYPE) I 

IE( (H0LD$TYP5 : = AN D$OUT$ OCCURS ( GETSTYPE ) ) =GROUP)  OR 
(L$TYPE=GRCUP) 

THEN  RETURN  ALPHAS NUM$ MOVE; 

IF  HOLD$TYPE=ALPHA  THEN 

I?  A$AN$TYPE  OR  ( L$TYPE=A$ED)  OR  ( LSTY?E=A$N$ED ) 

OR  ( (ALPHASLITSFLAG)  AND  (LSTYPE  * NONSNUMERICSLIT) ) 
THEN  RETURN  ALPHAS NUMSMOVS; 

I?  HOLDSTYPE=ALPHASNUM  THEN 

do; 

IF  NOTSINTEGER  THEN  CALL  INVALIDS TYPE ; 

RETURN  ALPHASNUMSMOVE; 

end; 

IF  (HOLD$TYPE>=NUMERIC)  AND  (HOLDSTYPE<=COMP)  then 

do; 

IF  (LSTYPE=ALPHA)  OR  ( L$TY®E>COMP ) THEN 
CALL  I NVALIDSTYPE; 

RETURN  NUMERICSMOVEJ 
END  * 

IF  HOLD$TYPE*ASNSED  THEN 

do; 

IF  NOTSINTEGER  THEN  CALL  INVALIDSTYPE J 
RETURN  ASNSEDSMCVE; 

end; 

IF  HOLDSTYPE*A.SED  THEN 

IF  ASANSTYPE  OR  ( L$TYPE>COMP ) OR  ( LSTYPE 
» NO Ni NUMERICAL  IT ) 

THEN  RETURN  ASNSEDSMCVE? 

IF  EOLDSTYPE*NUM$ED  THEN 

IF  NUMERICSTYPE  OR  (L$TYP.  =ALPHASNUM)  THEN 
RETURN  NSEDSmOVEJ 
CALL  INVALIDSTYPE; 

RETURN  0i 

END  movestype; 

GEN$MOVE:PROCEDURE; 

DECLARE 

LENGTH1  ADDRESS, 

ADDR1  ADDRESS, 

EXTRA  ADDRESS; 

ADDSADDSLEN:  PROCEDURE; 

CALL  CODE $ ADDRESS ( ADDR1 ) ; 

CALL  CODES  ADDRESS ( L$ ADDR ) ; 

CALL  CODES  ADDRESS ( LSLENGTH ) i 
END  ADDSADDSLEN; 

CODESFORSEDITj  PROCEDURE; 

CALL  ADDSADDSLEN? 

CALL  CODE$ ADDRESS ( GETSFCBSADDR ) J 
CALL  CCDE$ADDRESS( LENGTH1 ) » 

end  c odesforsedit; 
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CALL  LO AD$L$ ID( MPP1 ) » 

CUR$SYM=VALUI(SP); 

IF  ( ADDR1 :=VALUE2( SP ) )=0  THEN  ADDR1=GET$ADDRESS  » 

lengthi=get$length; 

DO  CASE  move$type; 

/*  ALPHA  NUMERIC  MOVE  */ 

do; 

IF  LENGTH1>L$ LENGTH  THEN  EXTRA=LENGTH1-L$ LENGTH; 
ELSE  do; 

EXTRA=0J 

l$length=lengthi; 

: .L  CODEiBTTE(MOV  ); 

CaLL  ADD$ ADDiLEN ; 

CALL  CODE^ADDRESS ( EXTRA  ) i 

end; 

/*  ALPHA  NUMERIC  EDITED  */ 

do; 

CALL  CODE$BYTE(MED ) » 

CALL  code$for*edit; 
end; 

/*  NUMERIC  MOVE  */ 

do; 

CALL  L0AD$REG(2,MPP1 )J 
CALL  STOREiREG(SP) ; 

END ; 

/*  NUMERIC  EDITED  MOVE  */ 

do; 

CALL  CODE$BTTE(MNE) ; 

CALL  CCDEiFOR$EDIT; 

CALL  CODEiBTTE(LiDEC) ; 

CALL  code$byte(get$decimal) ; 
end; 
end; 

END  GEN$M07E; 

CODE$GEN  : PROCEDURE ( PRODUCT  ION ) ; 

DECLARE  PRODUCTION  BYTE? 

IF  PRI NT$PROD  THEN 

do; 

call  crlf; 

CALL  PRI NTCHAR( POUND); 

CALL  PRINT$NUMBER( PRODUCTION); 

end; 

DO  CASE  production; 

/♦PRODUCTIONS*/ 

/*  CASE  0 NOT  USED  */ 

/*  1 <P-DIV>  ::=*  PROCEDURE  DIVISION  <USING>  . 

<PROC-BODT>  */ 
do; 

COMPILING  * FALSE; 


IF  section$flag  then  call  load$sec$label; 
end; 

/*  2 <USING>  ::=  USING  <ID-STRING>  */ 

CALL  NOT$IMPLlMENTEDJ  /*  INTER  PROG  COMM  */ 

/*  3 \ ! <EMPTT>  */ 

,*  /*  NO  ACTION  REQUIRED  */ 

/*  4 <ID-STRING>  ::=  <ID>  */ 

IDASTACK ( ID$PTR :=0 ) =VALUE(  SP ) J 
/*  5 \ ! <ID-STRING>  <ID>  */ 

do; 

IF( ID$PTR : =IDPTR+1 ) =20  THEN 

do; 

CALL  PRlNTAERROR(  'ID')J 
ID*PTR=19; 

end; 

ID$STACI( ID$PTR)=VALUE(SP); 

end; 

/*  6 <PR0C-3CDT>  ::=  <PARAGRAPH>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*  7 \ ! <PROC-BODY>  <PARAGRAPH>  */ 

J /*  NO  ACTION  REQUIRED  V 

/*  8 <PARAGRAPH>  : <ID>  . <SENTENCE-LIST>  */ 

do; 

IF  SECTIONAFLAG=0  THEN  SECTI0N$FLAG=2; 

CALL  loadala.bel; 
end; 

/*  9 \!  <ID>  SECTION  . */ 

do; 

IF  S3CTI0NAFLAGO1  THEN 

do; 

IF  SECT I CN$FLAG=2  THEN  CALL  PRI NT$ERROR ( 'P? ' ) i 
SECTION$?LAG=l ; 

holdasection=yalue( m?  ) ; 

H0LDASECiADDR*7ALUE2(MP) ; 

end; 

ELSE  CALL  LOADASECALABSLJ 

end; 

/*  10  <SENTENCE-LIST>  <SENTENCE>  . */ 

; /*  NC  ACTION  REQUIRED  */ 

/*  11  \ ! <SENTENCE-LIST>  <SENTENCE>  . */ 

; /*  NO  ACTION  REQUIRED  */ 

/*  12  <SENTENCE>  : :*  <IMPERATIYE>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  13  \I  <CONDITIONAL>  V 

; /*  NO  ACTION  REQUIRED  */ 

/*  14  \ ! ENTER  <ID>  <0?T-ID>  •/ 

CALL  N0T$IMPLIMENTED;  /*  LANGUAGE  CHANGE  */ 

/*  15  <IMPSRATIVE>  ACCEPT  <SU3ID>  */ 

do; 

CALL  LOAD$L$ID(SP); 

CALL  ONEAArDRAOP?(ACC,LAADDR) » 

CALL  CODEiB YTS ( LiLENGTH ) J 

end; 

/*  16  \I  <ARITHMETIC>  */ 
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J /*  NO  ACTION  REQUIRED  */ 

/*  17  \ ! CALL  <LIT>  <USING>  */ 

CALL  NOT$IMPLIMENTED;  /♦  INTER  PROG  COMM  */ 

/*  18  \!  CLOSE  <ID>  */ 

do; 

DECLARE  TYPE  BYTE; 

type»get$ty?e; 

IE  (TYPE>0 ) AND  (TYPE<5)  THEN 

CALL  ONEi ADDR$OPP( CLS ,GET$FCB$ ADDR ) ; 

ELSE  CALL  PRINT$ERROR( 'CE' ) ; 

end; 

/*  19  \!  <7ILE-ACT>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*  20  \ ! DISPLAY  <LIT/ID>  <OPT-LIT/ID>  */ 

do; 

CALL  CODEi FORiDISPLAY ( MPP1 ) • 

IP  V ALUE( SP)<>0  THEN 

do; 

dis?lay$flag*true; 

CALL  CODEiFORiDISPLAY(SP); 

end; 

end; 

/*  21  \ ! EXIT  <?ROGRAM-ID>  */ 

; /*  NO  ACTION  REQUIRED  V 

/*  22  \l  GO  < ID>  */ 

CALL  ON Si ADDR  iOPP( BRN, LABEL $ ADD? ( V ALUE ( SP ) , 1 ) ) J 
/*  23  \!  GO  < ID-STRI NG>  DEPENDING  <ID>  */ 

do; 

CALL  CODEiBYTE(GDP); 

CALL  CODE$BYTE(ID$PTP); 

CUR iS DM* VALUE ( SP ) J 

CALL  CODEiBYTE (GETiLENGTH ) J 

CALL  CODEiADDRESSfGETiADDRSSS) ; 

DO  CTR=0  TO  IDiPTR; 

CALL 

CODEi ADDRESS ( LABELi ADDRiOFFSST( IDiSTACXC IDiPTR),  1 ,0) ); 

end; 

EN  D » 

/*  24  \ ! M07E  <LI T/ID>  TO  <SU3ID>  V 

CALL  GENiMOVE; 

/*  25  \ ! OPEN  <TY?E-4CTION>  <ID>  */ 

do; 

DECLARE  TYPE  BYTE; 

TYPE*GETiTYPE; 

IF  ( TYPE*1  OR  TYPE=4)  AND  ( VALUS( MPP1 ) 02 ) 

THEN  CALL  0NE$ADDR$0PP(0PN+?ALUE(MP?1 ) ,GETi?C3iADDR ) J 
ELSE 

IF  ( TY?E=2  OR  TYP ?=3 ) THEN 

CALL  ONEiADDRiOPP(OPN+VALUE(MPPl ) .GETiFCBiADDR) J 
ELSE  CALL  PRINTiERPOR ( 'OE' ) ; 

end; 

/*  26  \ ! PERFORM  <ID>  <T3RU>  <FINIS3>  */ 

do; 

DECLARE  ( ADDP.2,  ADDR3)  ADDRESS; 
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IF  VALUE(SP-1)»0 

THEN  ADDR2=LABEL$ADDR$0FFSET( VALUE (MPP1 ) ,0,3); 

ELSE  ADDR2=LABEL$ADDR$0FFSET(7ALUE(SP-1) .0,3) J 
IF  ( ADDR3:=VALUE2(SP) )=0  THEN  ADDR3=NEXT$AVAI LARLE 
♦ ?; 

ELSE  CALL  BACKSTUFF(V ALUE( SP ) , NEXT $AV  AIL ABLE  + 7); 

CALL  0NE$ADDR$0PP( PER , LABEL$ ADDR( 7ALUI( MPP1 ) . 1 ) ) ; 

CALL  CODE$ ADDRESS (ADDR2  ) » 

CALL  C0DE$ ADDRESS(ADDR3  ) » 

end; 

/*  27  \f  <READ-ID>  */ 

CALL  NOTiIMPLIMENTED;  /♦  GRAMMAR  ERROR  V 
/*  28  \ ! STOP  <TERMI NATE>  */ 

do; 

IF  VALUE(SP)=*0  THEN  CALL  CODE$BYTE(STP); 

else  do; 

CALL0NEiADDR$0PP(STD,VALUE2(SP) ); 

CALLCODE$  BYTE( CO N$ LENGTH ) ; 

end; 

end; 

/*  29  <CONDITlONAL>  ::=  ^ARITHMETICS  <SIZE-ERRCRS  */ 

/*  29  <IMPERATI 7E>  */ 

CALL  BACK$COND; 

/*  30  \ ! <FILE-ACT>  <INVALID>  <IMPERATIVE>  */ 

CALL  back$cond; 

/*  31  \ ! < I F-N ON TERMINALS  CONDITIONS 

<ACTION>  ELSE  */ 

/*  31  <IMPERATI VE>  */ 

do; 

CALL  3 ACES  TUFF  ( V ALrJE(  MPPl ) , 7 ALUE2  ( SP-2  ) ) J 
CALL  BACKS  TUFF ( VALUE ( SP-2 ) , NEXT$ A VA I LAB LS) ; 

end; 

/*  32  \ ! <RBAD-ID>  <SPSCIAL>  <IMPERATIVS>  */ 

CALL  back$cond; 

/*  33  <ARITHMETIC>  : :=  ADD  <L/ID>  <0PT-L/ID>  TO 

<SUBID>  */ 

/*  33  <ROUND>  */ 

CALL  ADD$SUB(0); 

/*  34  \ I DIVIDE  <L/ID>  INTO  <SUBID>  <EOUND>  */ 

CALL  MULT$DIV(1); 

/*  35  \!  MULTIPLY  <L/IDS  3T  <SUBIDS  <ROUND>  */ 

CALL  MULT$DI7(0); 

/*  36  \I  SUBTRACT  <L/ID>  <OPT-L/ID>  FROM  */ 

/*  36  <SUBID>  <ROUND>  V 

CALL  ADDiSUB(l); 

/*  37  <FILE-ACT>  : :*  DELETE  <ID>  */ 

CALL  DELETE$AiFILE; 

/*  38  \ ! REWRITE  <ID>  */ 

CALL  rewrits$a$record; 

/*  39  \!  WRITE  < IDS  <SPEC I AL-ACTS  */ 

CALL  writs$a$record; 

/*  40  CONDITIONS  <LIT/IDS  <NOTS  COND-TTPES  */ 

do; 

IF  IF$FLAG  THEN 
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DO? 

IF$FLAG=NOT  IF$FLAG;  /*  RESET  IF$FLAG  */ 

CALL  COrE$3YTE(NEG)5 

end; 

CALL  GEN$COMPARE; 

end; 

/*  41  <COND-TYPE>  NUMERIC 

C0ND$TTPE*3; 

/*  42  \!  ALPHABETIC  */ 

COND$TTPE=4; 

/*  43  \I  <COMPARE>  <LIT/ID> 

CALL  KEEPAVALUES; 

/*  44  <NOT>  ::=  NOT  */ 

IF  NOT  IFSFLAG  THEN 
CALL  CODE$BYTS(NEG); 

ELSE  IF$FLAG=NOT  IFAFLAGJ  /*  RESET  IF$FLAG  */ 

/*  45  \!  <EMPTY>  */ 

; /♦  NO  ACTION  REQUIRED  */ 

/*  46  <COMPARE>  GREATER 

COND$TY?E=0 ; 

/*  47  \ ! LESS  */ 


ROUNDED 


/*  47  \ ! LESS  */ 

COND$TYPE=l ; 

/*  48  \!  EQUAL  ♦/ 

C0ND$TYPE=2J 

/*  49  <ROUND>  ROUNDED  */ 

CALL  SET$VALUE(1) ? 

/*  50  \!  <EMPTY>  */ 

; /*  NO  ACTION  REQUIRED  */ 

/*  51  <TERMINATE>  <LITERAL>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  52  \ ! RUN  */ 

; /*  NO  ACTION  REQUIRED  - VALUE(SP)  ALREADY  ZERO  */ 

/*  53  <SPEC  IAL>  ::=*  <INVALID>  */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  54  \1  END  */ 

do; 

CALL  SET$VALUE(2)J 
CALL  CODE$BYTE( EOR ) * 

CALL  set$branch; 
end; 

/*  55  <OPT-ID>  <SUBID>  */ 

; /*  VALUE  AND  VALUE2  ALREADY  SET  */ 

/*  56  \ ! */ 

J /*  VALUE  ALREADY  ZERO  */ 

/*  57  <ACTICN>  <IMPERATIVE>  */ 

CALL  UNRESOLVEDiBRANCHJ 

/*  58  \ ! NEXT  SENTENCE  */ 

CALL  unresclvsd$branch; 

/*  59  <THRU>  THRU  <ID>  */ 

CALL  KEEP$VALUES; 

/*  60  \ ! */ 

; /*  NO  ACTION  REOUIRED  */ 

/*  61  <FINISH>  <L/ID>  TIMES  */ 

do; 


CALL  LOAD$L$ID(MP)J 

CALL  0NE$ADDP.$0PP(LDI  ,L*ADDP.) 

CALL  CODE $ BITE ( L$LENGTH ) ; 

CALL  SET$VALUE2(NEXT$AVAILABLE); 

CALL  ONE$ADDR$OPP(DEC ,0 ) J 
CALL  SET$VALUE(NEXT$AVAILABLS) J 
CALLC ODE$ ADDRESS ( 0 ) » END; 

/*  52  \ ! UNTIL  <CONDITION>  */ 

CALL  KEEP*VALUES; 

/*  63  \l  */ 

I /*  NO  ACTION  REQUIRED  */ 

/*  64  <INVALID>  INVALID  */ 

DO? 

CALL  SET$VALUE(1); 

CALL  CODE$BYTE( INV) ; 

CALL  setsbranch; 
end; 

/*  65  <SIZE-ERRO?>  s :=  SIZE  ERROR  */ 

do; 

CALL  CODE$BYTE(SER) ; 

CALL  UNRESOLVED$BRANCH; 

end; 

/*  66  <SPSCIAL-AC?>  <WHEN>  ADVANCING  <HO¥-MANY>  */ 

CALL  NOT$I MPLIffENTED;  /*  CARRAGE  CONTROL  */ 

/♦  67  \ ! */ 

; /*  NO  ACTION  REQUIRED  V 

/*  6e  <WHEN>  BEFORE  */ 

CALL  NOTAIMPLIMSNTEDJ  /*  CARRAGE  CONTROL  */ 

/*  69  \ ! AFTER  */ 

CALL  N0T$IMPLIMENTED;  /*  CARRAGE  CONTROL  */ 

/*  70  <HOW-l*AN  Y>  ::=  <INTEGER>  */ 

CALL  NOTiIMPLiPENTED;  /*  CARRAGE  CONTROL  */ 


/*  70  <HOW-^ANY>  = 

CALL  NOTSIMPLIPENTED; 
/*  71  \ ! PAGE 

CALL  NOTSIMPLIMENTED; 
/*  72  <TYPE-ACTION> 


/*  CARRAGE  CONTROL  */ 
INPUT 


J /*  NO  ACTION  REQUIRED  - VALUE(SP)  ALREADY  ZERO  */ 
/♦  73  \ ! OUTPUT  */ 

CALL  SET$7ALUE(1); 

/*  74  \ ! 1-0  */ 

CALL  S3T$VALUE(2); 

/*  75  <SUB I D>  <SUBSCRIPT>  */ 

; /*  VALUE  AND  VALUE2  ALREADY  SET  */ 

/*  76  \l  <ID>  */ 

; /*  NO  ACTION  REQUIRED  V 
/*  77  <INTSGER>  = <INPUT>  */ 

CALL  SET$VALUE( CONVERTS  I NTEGSR) ; 

/*  78  <ID>  <INPUT>  */ 

do; 

CALL  SETSV ALUE( MATCH) J 
IF  GET$TYPE»UNP.ES0L7ED  THEN 

CALL  SET$VALUE2( NEXTSAVAILAELE) ; 

end; 

/*  79  <L/ID>  <IN?UT>  */ 

do; 


IF  NUMERIC$LIT  THEN 

do; 

CALL  SET$ VALUE (NUMERIC 4 LITERAL) J 
CALL  S2T$VALUE2(ST0RE$C0NSTANT) J 

end; 

ELSE  CALL  SETtVALUE (MATCH ) ; 

END; 

/*  80  \ ! <SUBSCR IPT>  * 

; /*  NO  ACTION  REQUIRED  */ 

/*  81  \l  ZERO  */ 

CALL  set$value(lit$zero); 

/*  82  <SURSCRIPT>  <ID>  ( <INPUT>  ) 

CALL  check$surscript; 

/*  83  <OPT-L/ID>  <L/ID> 

; /*  NO  ACTION  REQUIRED  */ 

/*  84  \ ! <EM?TT>  */ 

J /*  VALUE  ALREADY  SET  */ 

/*  85  <NN-L IT>  <LIT> 

do; 

AL?HAtLIT$  FLAG  = ALPEAtLITJ 
CALL  SETiVALUE(NON$NUMERIC$LIT); 

CALL  S ET$V ALUE2( STORE $ CONSTANT ) J 

end; 

/*  36  \ ! SPACE  */ 

CALL  SET$VALUE(LIT$SPACE) J 
/*  87  \ I QUOTE  */ 

CALL  SET$ VALUE ( LITtCUOTE ) » 

/*  ee  <LITSRAL>  : :=  <NN-LIT> 

; /*  NO  ACTION  REQUIRED  */ 

/*  89  \ ! <lNPUr>  */ 

DO  * 

'if  NOT  NUMERICtLIT  THEN  CALL  I NVALIDtTYPE* 

CALL  SET tV  ALUE( NUMERI C$ LI TEFAL ) J 
CALL  SET$VALUE2(ST0REtC0NSTANT) J 

end; 

/*  90  \ ! ZERO  */ 

CALL  SET$VALUE'LIT$ZERO) ; 

/*  91  <LIT/ID>  <L/ID> 

; /*  NO  ACTION  REQUIRED  */ 

/*  92  \ ! <NN-LIT>  */ 

; /*  NO  action  required  */ 

/*  93  <OPT-LIT/ID>  : :*  <LIT/ID> 

J /*  NO  ACTION  REQUIRED  */ 

/*  94  \ ! <EMPTY>  */ 

J /*  NO  ACTION  REOUIRED  */ 

/*  95  <PROGRAM-ID>  : :*  <ID> 

CALL  NCTtlMPLlMENTSD*  /*  INTER  PR CG  COMM  */ 

/*  96  \ ! */ 

J /*  NO  ACTION  REQUIRED  */ 

/*  9?  <READ-ID>  READ  <ID> 

CALL  READtAtFILEJ 

/*  98  <IF-NONTERMlNAL>  IF  ♦/ 

IFtFLAG  * TRUE;  /*  SET  IFtFLAG  */ 


END  OF  CASE  STATEMENT  */ 


endcode$gen; 

GETIN1 -.PROCEDURE  BYTE; 

RETURN  INDEX1 (STATE)? 

ENDGETIN1? 

GETIN2: PROCEDURE  BITE; 

RETURN  INDEX2 (STATE ) i 
ENDGETIN2J 

INCSP : procedure; 

VALUE(SP:=SP  + 1)=05  /*  CLEAR  THE  STACK  WHILE 

INCREMENTING  */ 

VALUE2( SP)=0J 

IF  SP  >=  PSTACKSIZE  THEN  CALL  FATA L$ ERROR ( 'SO ' ) ; 
ENDINCSP; 

LOOKAHEAD :PROCEDURE; 

IT  NOLOOK  THEN 

do; 

CALL  scanner; 
nolcok=false; 

IF  PRINT$TOKEN  THEN 

do; 

call  crlf; 

CALL  PRINTiNUMBER (TOKEN); 

call  print$char('  '); 
call  print$accum; 
end; 
end; 

endlookahead; 

NO SCONFL I CT : PROCEDURE  (CSTATE)  BTTE; 

DECLARE  (CSTATE, I, J,K)  BYTE; 

J=INDEX1(CSTATE)J 

K=J  ♦ I NDEX2 ( CST»TE ) - 1J 

DO  I=J  TO  k; 

IF  READ1( I )*TOKEN  THEN  RETURN  TRUE; 

end; 

returnfalse; 

ENDNOiCONFLICT; 

RECOVER: PROCEDURE  BYTE; 

DECLARE  TS?  BYTE,  RSTATE  BYTE; 

DO  forever; 

TS  S P ? 

DO  WHILE  TSP  <>  255; 

IF  NO$ CONFLICT ( RSTATE :*S TATE STACK ( TSP ) ) THEN 
DO;  /*  STATE  WILL  READ  TOKEN  */ 

IF  SPOTS?  THEN  S?  ■ TSP  - 1? 

RETURN  RSTATE? 

end; 

TSP  » TSP  - 1; 

end; 

CALL  SCANNER;  /*  TRY  ANOTHER  TOKEN  */ 

end; 

sndrecover; 

/****•  PROGRAM  EXECUTION  STARTS  HERE  * * */ 

/*  INITIALIZATION  */ 

T0KEN*63 ; /*  PRIME  THE  SCANNER  WITH  -PROCEDURE-  * 


CALLMCVS(PASS1$T0P-?ASS1$IEN , ,OUTPUT$FCB  f PASS1$LEN ) ; 

/*  THIS  SETS 

OUTPUT  FILE  CONTROL  BLOCK 

TOGGLES 

READ  POINTER 

NEXT  SYMBOL  TABLE  POINTER 

*/ 

OUTPUT$END= ( OUTPUT$PTR OUTPUT* BUFF-1) +129? 
CALLPRlNT$ERROR(FALSS);  /*  INITIALIZE  ERROR  MSG  OUTPUT  */ 
/««*****  PARSER  ******/ 

DO  WHILE  compiling; 

IF  STATE  <=  MAXRNO  THEN  /*  READ  STATE  */ 

do; 

call  incsp; 

STATESTACK (SP ) = STATE;  /*  SAVE  CURRENT  STATS  */ 

call  lookahead; 

I*GETIN1 J 

J * I ♦ GETIN2  - 15 
DO  1*1  TO  j; 

IF  READ1 (I ) = TOKEN  THEN 

do; 

/*  COPY  THE  ACCUMULATOR  IF  IT  IS  AN  INPUT 
STRING.  IF  IT  IS  A RESERVED  WORD  IT  DOES 
NOT  NEED  TO  BE  COPIED.  */ 

IF  (TOKEN=lNPUT$STR)  OP  ( TOKEN*LITERAL ) THEN 
DO  K=0  TO  ACCUM(0); 

VARC ( K ) - ACCUM (K  ) 5 

end; 

STATE=READ2( I ) ; 

nolcck=true; 
i 3 j ; 
end; 

ELSE 

IF  I=J  THEN 

do; 

CALL  PPIN«ERR0R(  'NP')5 
CALL  FRINT( .SRRCR$NEAR$$) ; 

CALL  PRINTAACCUM? 

IF  ( STATE :*RECOVSR  )=0  THEN  COMPILING=FALSE  J 

end; 

end; 

end;  /*  end  of  read  state  */ 

ELSE 

IF  STATE>MAXPNO  THEN  /*  APPLY  PRODUCTION  STATE  */ 

do; 

MP*S ? - GETIN2; 

MPPl =MP  + IS 

CALL  CODE$GEN (STATE  - MAXPNO); 
sp*mp; 

I»GETIN1; 

J=ST ATESTACK ( S? ) J 

DO  WHILE  (K:«APPLY1(I  ) ) <>  0 AND  JOKJ 
I»I  ♦ IS 

end; 


IT  ( K:=APPLY2( I ) )=0  THEN  COMPILI NG=FALSE 

stats=k; 

end; 

ELSE 

IE  STAT E<=MAXLNO  THEN  /♦LOOKAHEAD  STATE*/ 
DO? 

I-GETIN1J 

CALL  lookahead; 

DO  WHILE  (K:=LOOKl( I) )<>0  AND  TOKEN  OKI 

1*1+1; 

end; 

STATE=L00K2( I ); 

end; 

ELSE 

do;  /*push  states*/ 

CALL  INCSP; 

STATESTACK i SP)=GETIN2J 

stats-getini; 

end; 

end;/*  of  while  compiling  */ 

CALLBTTESOUT(TER); 

DOWEILE  OUTPUT  SPTRO . OUTPUTS  BU?T  ; 

CALL  BYTESOUT(TER); 


end; 

callclose; 

callcrlf; 

CALLPRINT( .ENDS0F$PART$2) J 

callboot; 

end; 
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INTERP: 

/*  MODULE 

" I N T I R P 

*/ 

DO? 

/* 

COBOL  INTERPRETER 

*/ 

/* 

NORMALLY  ORG'ED 

TO  X'100' 

*/ 

/* 

GLOBAL  DECLARATIONS  AND  LITERALS  */ 

DECLARE 

LIT 

LITERALLY 

'LITERALLY', 

BDOS 

LIT 

'5H ' , /* 

ENTRY  TO  OPERATING 

STSTEM  */ 

BOOT 

LIT 

'0', 

CR 

LIT 

'13', 

LF 

LIT 

'10', 

TRUE 

LIT 

'1', 

FALSE 

LIT 

'0  , 

FOREVER 

LIT 

'WHILE  TRUE'? 

/* 

UTILITY  VARIABLES 

*/ 

DECLARE 

BOOTER 

ADDRESS 

INITIAL  ( 0000H ) , 

INDEX 

BYTE, 

ASCTR 

ADDRESS, 

CTR 

BYTE, 

CTR1 

3YTE , 

BASE 

ADDRESS, 

BSBYTE 

BASED  BASS 

(1) 

BYTE, 

3$ADDR 

BASED  BASE 

(1) 

ADDRESS, 

HOLD 

ADDRESS, 

HSBYTE 

BASED  HOLD 

(1) 

BYTE, 

H$ADDR 

BASED  HOLD 

(1) 

ADDRESS, 

/*  CODE 

POINTERS  */ 

CODE$STA*T 

LIT 

'3200H ' , 

PROGRAM$  COUNTER  ADDRESS, 

C$BYTE  BASED  PROGRAMS COUNTER  (1)  BYTE, 

CSADDR  BASED  PROGRAM $ COUNTER  (1)  ADDRESS ? 


/♦****  GLOBAL  INPUT  AND  OUTPUT  SOUTINES  ****♦/ 


DECLARE 

CURRENTS FCB  ADDRESS, 

START$OFFSET  LIT  '3?'? 

MON  1 : PROCEDURE  (F,A)  EXTERNAL? 
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DECLARE  F BYTE , A ADDRESS? 

END  MONI? 

M0N2:  PROCEDURE  (F,A)  BYTE  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 

END  M0N2  ? 

PRINT$CHAR:  PROCEDURE  (CHAR)? 

DECLARE  CHAR  3YTE? 

CALL  MONI  (2, CHAR)? 

END  PRINT$CHAR  ? 

CRLF:  PROCEDURE? 

CALL  PR  iNTiCHAF.  ( CR  ) ? 

CALL  PRINT$CHAR(LF) ? 

END  CRLF? 

PRINT:  PROCEDURE  (A)? 

DECLARE  A ADDRESS? 

CALL  CRLF? 

CALL  MONKS, A)? 

END  PRINT? 


READ:  PROCEDURE(A) ? 

DECLARE  A ‘DDRESS? 
CALL  MONI ( 10 , A ) ? 
END  READ? 


PR I NT $ ERROR:  PROCEDURE  (CODE)? 
DECLARE  CODE  ADDRESS? 

CALL  CRLF? 

CALL  PRINT$CHAR( HIGH ( CODE) ) ? 
CALL  PR I NT $ CHAR ( LOW (CODE) ) ? 
END  PRlNT$ERROR? 


?ATAL$ERROR : PROCEDURE( CODE ) ? 
DECLARE  CODE  ADDRESS? 

CALL  PRlNT$ERROR(CODE)? 
CALL  BOOTER? 

END  FATAL$ERROR? 


SETiDMA:  PROCEDURE? 

CALL  MONI  (26,  CURR ENT$FCB  ♦ ST ART$OFFSET ) ? 
END  SET$DMA ? 


OPEN:  PROCEDURE  ( ADDR ) BYTE? 

DECLARE  A DDR  ADDRESS? 

CALL  SET$DMA?  /*  INSURE  DIRECTORY  READ  WON'T 

CLOBBER  CORE  */ 


RETURN  M0N2(15,ADDR); 
2ND  OPEN,* 


CLOSE:  PROCEDURE  ( ADDR ) » 

DECLARE  ADDR  ADDRESS; 

I?  M0N2 ( 16  , ADDR ) =255  THEN  CALL  FATALSEPROR ( 'CL ' ) J 
END  close; 


DELETE:  PROCEDURE; 

CALL  MON 1 ( 19, CURRENTS FCB) J 

END  delete; 


MAKE:  PROCEDURE  (ADDR ) J 
DECLARE  ADDR  ADDRESS; 

IF  MON 2 ( 22 , ADDR ) =255  THEN  CALL  FATALS ERROR ( 'ME ') J 

end  make; 


DISK$READ:  PROCEDURE  BITE? 

RETURN  MON2(20,CURRSNT$FCB); 
END  DISK$READ5 


DISKSWRITE:  PROCEDURE  BYTE? 

RETURN  MO N2 ( 21 .CURRENTS FCB ) J 

END  disk$i»rite; 


/**♦**  UTILITY  PROCEDURES  *******/ 


DECLARE 

SUBSCRIPT  (8)  address; 


RES:  PROCEDURE ( ADDR ) ADDRESS? 

/*  THIS  PROCEDURE  RESOLVES  THE  ADDRESS  OF  A 
SUBSCRIPTED  IDENTIFIER  OR  A LITERAL  CONSTANT  */ 

DECLARE  ADDR  ADDRESS? 

IF  ADDR  > 32  THEN  RETURN  ADDR? 

IF  ADDR  < 9 THEN  RETURN  SUBSCRIPT! ADDR ) ? 

DO  CASE  ADDR  - 9? 

RETURN  .('0')? 

RETURN  .('  ')? 

RETURN  .('  ')? 

END? 

RETURN  0? 

END  res; 
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MOVE:  PROCEDURE ( FROM .DESTINATION , COUNT ) i 

DECLARE  (FROM, DESTINATION, COUNT)  ADDRESS, 

(F  BASED  FROM,  D BASED  DESTINATION)  BITE? 
DO  WHILE  ( COUNT :=COUNT  -1)0  0FFFFHJ 

d=f; 

FROM*FROM  ♦ l; 

dsstination=destination  + 1; 

end; 
end  move; 


FILL:  PROCEDURE! DESTINATION .COUNT , CHAR  ) 5 
DECLARE  (DESTINATION, COUNT)  ADDRESS, 

( CHAR ,D  EASED  DESTINATION)  BYTE; 
DO  WHILE  ( COUNT:=COUNT  - 1)0  0FFFFHJ 

d=char; 

DESTlNATION=DESTINATION  + 1? 

end; 

END  fill; 


CONVERT$TOSESX:  PROCEDURE ( POI NTER .COUNT ) ADDRESS  « 

DECLARE  POINTER  ADDRESS,  COUNT  BYTE; 

A$CTR=0J 

base*pointer; 

DO  CTR  = 0 TO  COUNT-1 ; 

A$CTR=SHL(ASCTR ,3  ) * SHL <A$CTX, 1 ) + 3$ BYTE (CTR ) - '0'i 

end; 

RETURN  AS  CTR; 

END  CONVERT$TOSHEXJ 


/*****  CODS  CONTROL  PROCEDURES  ****#/ 
DECLARE 

BRANCH$FLAG  BYTE  I N I T I A L ( FALSE); 

INCSPTR:  PROCEDURE  (COUNT); 

DECLARE  COUNT  BYTE; 

PROGRAMS  COUNTER®  PROGRAMS  COUNTER  * COUNT.* 
END  INCSPTRJ 


GETSOPSCODE:  PROCEDURE  BYTE? 

ctr=csbyte (0 ) ; 

CALL  INCSPTR(l); 

RETURN  CTR; 

END  GETSOPSCODE; 


CONDSBRANCH:  ?ROCSDURE(  COUNT ) ,* 

/*  THIS  PROCEDURE  CONTROLS  BRANCHING  INSTRUCTIONS  */ 


DECLARE  COUNT  BYTE? 

II  BRANCHAFLAG  THEN 
DO? 

bbancb$flag=false; 

PR OGRAM$COUNTER=CAADDR( COUNT) ? 

end; 

ELSE  CALL  INCAPTR ( SHL ( COUNT, 1 ) +2 ) J 

END  condabranch; 


INCR$0RA BRANCH : PROCEDURE ( MARK ) ; 

DECLARE  MARK  BYTE; 

IF  MARK  THEN  CALL  INC$PTR(2); 

ELSE  PROGR AMAC0UNTER=C$ADDR( 0 ) ? 

END  incraorabranch; 

/**#**  ^COMPARISONS  **♦**#**/ 


CEARACOMPAPE:  PROCEDURE  3YTE; 

base=caaddr( 0 ) ; 

HOLD-C A ADD? ( 1 ) # 

DO  A $CTR=0  TO  C$ ADDR ( 2 ) - 1? 

I?  BA  BYTE ( AACTR)  > H$ BYTE ( AACTR ) THEN  RETURN  1? 
IF  B$BYTE( A$CTR ) < HA  BYTE ( A$ CTR  ) THEN  RETURN  0,* 

end; 

RETURN  2? 

END  charAcompare; 


STRINGACOMPARE:  ?ROCEDURE( PIVOT) ; 

DECLARE  PIVOT  BYTE 5 

IF  cha?.acompa?e=pivot  then  bpanchaflag=not  branchaflag; 

CALL  CONDABR  ANCH (3  ) ; 

END  STRINGACOMPARE; 
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END  sign; 


COMP$NUM$UNSIGNED:  PROCEDURE; 
BASE=C$ADDR(0)5 
DO  A$CTR=0  TO  C$ADDR(2)-i; 

IF  NOT  NUMERIC (B$BYTE ( A$CTR ) ) THEN 

do; 

BP ANCH$FLAG=NOT  BRANCB$FLAC; 

return; 

end; 

end; 

CALL  C0ND$BRANCH(2)  ; 

END  comp$num$unsigned; 


COMP$NUM£S IGN : procedure; 

BASE=C$ADDR(0); 

DO  A ACTR=0  TO  C$ADDR(2)-1J 

IF  NOT ( NUMERIC ( CTR :=B$ BYTE ( A$CTR ) ) 
OR  SIGN(CTR) ) THEN 

do; 

BRANCH5FL AG=NOT  BRANCH$FLAG; 

return; 

end; 

end; 

CALL  CONDiBRANCH (2) > 

END  COMPiNUM^S IGN; 


COMPA ALPHA : PROCEDURE; 

BASE=C$ADDR(0)J 
DO  AiCTR=0  TO  C$ADDR(2)-i; 

IF  NOT  LSTTER(B$BYTE(A$CTR))  THEN 

do; 

BF  ANCHiFL AG=NOT  3RANCH$FLAGJ 

return; 

end; 

end; 

CALL  COND$BRANCH (2)  ; 

END  ccmp$alpha; 


/*****  ^numeric  OPERATIONS  *****«■/ 


DECLARE 

( RP  ,R1 , R2  ) (10)  BYTE,  /*  PEGISTERS  */ 

SIGN0 ( 3 ) BYTE, 

(DECAPT0  ,DEC$PT1 ,DEC$?T2)  BYTE, 

DEC$PTA  (3)  BYTE  AT  (.DEC$PT0), 

OVERFLOW  BYTE, 


R$PTR 

SWITCH 

SIGNIFSNO 

ZONE 

POSITIVE 

NEGITIVE 


BYTE. 

BYTE, 

BYTE, 

LIT 

LIT 

LIT 


'10H', 


CHECKS FOR$SIGN:  PROCEDURE ( CHAR ) BYTE; 

DECLARE  CHAR  BYTE? 

IF  NUMERIC (CHAR)  THEN  RETURN  POSITIVE; 

IF  NUMERIC (CHAR  - ZONE)  THEN  RETURN  NEGITIVE; 

CALL  print$error('si'); 

RETURN  POSITIVE; 

end  check$for$sign; 


STORES  IMMEDIATE:  PROCEDURE; 
DO  CTR=0  TO  9? 

R0(CTR)=R2(CTR); 

end; 

DEC$PT0=DEC$PT2; 

SIGN0(0)=SIGN0(2)J 

END  s tore simmedi ate; 


onesleft : procedure; 

DECLARE  (CTR,  FLAG)  BYTE; 

IF  ( (FLAG:=SH?(3$BYTE(0) ,4) )=0)  OP  (FLAG-9)  THEN 

do; 

do  ctr=0  to  e; 

3$BYTE( CTR  )=SHL( 3$B YTE( CTR ) ,4 ) OR 
shr(b$byte(ctr+d,4); 
end; 

B$BYTE(9)*SHL( BSBYTE (9 ) ,4 ) OR  FLAG; 

END; 

ELSE  cvsrflcw=true; 
end  onesleft; 


ONESRIGHT:  procedure; 

DECLARE  CTR  BYTE? 

CTR-10J 

do  index=i  to  9; 

CTR*CTR-i; 

BSBYTE(CTR)=SER(B$3YTE(CTR),4)  OR 
SHL(BS3YTE(CTR-1) ,4) ; 

end; 

B$BYTE(0)*SHR(BSBYTE( 0) ,4) ; 

IF  B $BYTS ( 0 ) = 09H  THEN 
3$ BYTE (0 ) = 99H? 

END  onesright; 


SHI  FT $ RIGHT:  PROCEDURE* COUNT ) ; 
DECLARE  COUNT  BYTE? 

DO  CTR-1  TO  COUNT? 

CALL  ONE$RIGHTJ 

end; 

END  SHIFT$RIGHT; 


SHI FT$LEFT : PROCEDURE  (COUNT); 
DECLARE  COUNT  BYTE? 

overflow=talse; 

DO  CTR-1  TO  COUNT? 

CALL  one$left; 

IT  OVERFLOW  THEN  RETURN; 

end; 

end  shift$left; 


ALLIGN:  PROCEDURE; 

BASE-.R0J 

IF  DECSPT0  > DEC$PT1  THEN 

CALL  SHI?T$RIGHT(DEC$PT0-DEC$PT1); 

ELSE  CALL  SHIFT$LEFT( DEC$PT1-DSC$PT0 ) ; 
END  allign; 


ADD$R0 : PROCEDURE* SECOND,  DEST); 

DECLARE  (SECOND,  DEST)  ADDRESS,  (C Y,A,B,I,J)  BYTE 
HOLD-  second; 

BASE  - DEST; 

CY-0; 

CTR-9J 

DO  J-l  TO  10; 

A-R0 ( CTR  ) ; 

B-H*BYTE(CTR); 

I-DEC ( A+CY  ) ; 

cy-carry; 

I-DEC ( I ♦ B); 

CY-( C Y OR  CARRY)  AND  1J 
BiBYTE* CTR)*I5 
CTR-CTP.-i; 

END; 

IF  CY  THEN 

do; 

CTR-9; 

DO  J - 1 TO  10? 

I-BiBYTE(CTR); 

I-DEC(I+CT); 

CY-CARRY  AND  1? 

B$BYTE( CTR) -I J 
CTR-CTR-1 ; 

end; 

end; 

END  ADD$R0J 
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COMPLIMENT:  PROCEDURE(NUMB ) ; 
DECLARE  NUMB  BYTE; 


S IGN0( NUMB  ) = SIGN0 (NUMB ) XOR  1J 

DO  CASE  numb; 

HOLD®  .R0; 

HOLD®  .Ri; 

HOLD® .R2 ; 

end; 


/*  COMPLIMENT 
SIGN  */ 


DO  CTR=0  TO  9; 

H$BYTE( CTR ) =99H  - H$3YTE(CTR); 

end; 


END  compliment; 


R2$ZER0:  PROCEDURE  BYTE; 

DECLARE  I BYTE; 

IF  (SHLU210)  ,4)00)  OR  (SHR(  R2(9)  ,4)00) 
THEN  RETURN  FALSE; 

ELSE  DO  1=1  TO  8J 

IF  R2( I )<>0  THEN  RETURN  FALSE? 

end; 

RETURN  TRUE; 

END  R2$ZERC; 

CHECKiRESULT:  PROCEDURE? 

IF  SHR(R2( 0) ,4)=9  THEN  CALL  COMPLIMENT (2 ) J 
IF  SHR(R2(0)  ,4)00  THEN  OYEEFLCW=TRUE ? 

END  chsck$result; 


CEECK$SIGN : PROCEDURE? 

IF  S IGN0( 0 ) AND  SI3N0 ( 1 ) THEN 

do; 

sign0(2)=positive; 

return; 

end; 

SIGN0(2)»N3GITI7E? 

IF  NOT  SIGN0(0)  AND  NOT  SIGN0(1)  THEN  RETURN? 
IF  SIGN0O)  THEN  CALL  COMPLI MENT(  1 ) J 
ELSE  CALL  C0MPLIMENT( 0 ) ; 

END  CHECKiS  IGNJ 


LEADING$ZEROES : PROCEDURE  ( ADDR ) BYTE? 
DECLARE  COUNT  BYTE,  ADDR  ADDRESS? 
COUNT=0? 
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base=addr; 

DO  CTR=0  TO  9; 

IT  (BSBYTE(CTR)  AND  0F0H)  <>  0 THEN  RETURN  COUNT? 
COUNT=COUNT  + IS 

IE  (B$BYTE( CTR ) AND  0FH ) <>  0 THEN  RETURN  COUNT? 
COUNT=COUNT  + 1? 

END? 

RETURN  COUNT? 

END  LEADI NG$ZERCES ? 


CHECX$DECIMAL : PROCEDURE? 

IF  DEC$PT2<> ( CTR :*C$BYTE(3 ) ) THEN 
DO? 

BASE* . R2  ? 

IF  DEC$PT2  > CTR  THEN  CALL  SHIFT$RIGHT( DEC$ PT2-CTR ) ? 
ELSE  CALL  SHIFT$LEFT( CTR-DSC$?T2  ) ? 

END? 

IF  LEADINGS  ZEROES ( . R2 ) < 19  - C$BYTE(2)  THEN  OVERFLOW 
= TRUE? 

END  CHECR$DECir-AL? 


ADD:  PROCEDURE? 

OVERFLOW=FALSE  ? 

CALL  ALLIGN? 

CALL  CHECKSSIGN? 

CALL  ADDR0( .R1..R2) ? 
CALL  CHECK$RESULT? 
END  ADD? 


ADDSSERIES:  PR CCEDURE( COUNT ) ? 
DECLARE  (I, COUNT)  BYTE? 

DO  1*1  TO  COUNT? 

CALL  ADDSR0 ( .R2, .R2) ? 

END? 

END  ADDSSERIES? 


SZTS^ULTSDI V : PROCEDURE? 

OVERFLOW*FALSE? 

SIGN0(2 ) * (NOT  (SI GN0 (0 ) XOR  SIGN0(1)))  AND  013? 
CALL  FILL( .R2.10.0) ? 

END  SETSMULT$DIV? 


RlSGR EATER:  PROCEDURE  BYTE; 

DECLARE  I BYTE? 

DO  CTR*0  TO  9? 

IF  R1 ( CTR ) > ( I : *99H-R0 ( C TR ) ) THEN  RETURN  TRUE? 
IF  RKCTRXI  THEN  RETURN  FALSE? 

END? 

RETURN  TRUE? 


END  RlSGREATER; 


MULTIPLY:  PROCEDURE! VALUE ) J 
DECLARE  VALUE  BYTE; 

IF  VALUEO0  THEN  CALL  ADD$SERIES( VALUE) ; 
BASE3 .R0  * 

CALL  onesleft; 
end  multiply; 


DIVIDE:  PROCEDURE; 

DECLARE  (I,  J,  K , LZ0,  LZ1,  X)  BYTE? 

CALL  SET$MULT$DIVJ 

IF  ( LZ0 : ^LEADINGS  ZEROES ( .R0) )<> 

(X  :=  (LZ1  :=  LSADlNG$ZEPOES ( .HI ) ) ) 
DO; 

IF  LZ0>LZ1  THEN 

do; 

BASE  3 .R0; 

CALL  SHIFT$LEFT  ( I :=  LZ0-LZ1 ) J 
DEC$PT0=DIC  $?T0  + i; 

x = lzi; 

end; 

else  do; 

BASF  = .Ri; 

CALL  SEIFTSLEFT  ( I : = LZ1-LZ0  ) J 

dec$pti=decpti  + r; 

x = LZ0 ; 

end; 

end; 

DECPT2=  18  - X + DECPT1  - DFCPT0J 
CALL  COMPLIMENT ( 0 ) J 
DO  I 3 X TO  19; 
j=0; 

DO  WHILE  RlSGREATER; 

CALL  ADD$R0 ( .Rl,  .Rl)  ; 

IF  Rl ( 0 ) 3 993  THEN 

CALL  COMPLIMENT  (1)J 

j*j+i; 

end; 

K3SHH(i  ,i); 

IF  I THEN  R2(K  )=R2(K)  OR  JJ 
ELSE  R2 ( I )*R2 ( X ) OR  SHL(J,4); 
BASE3.R0J 
CALL  onsSright; 

end; 

end  divide; 


LOADS A$CEAR : PROCEDURE! CHJ  R ) ; 
DECLARE  CHAR  BYTE; 


23? 

I 


THEN 


IF  ( SWITCH  : = NCT  SWITCH)  THEN 

B$BYTE(R$PTR)»B$BYTE(R?PTR)  OR  SHL(  CHAR  - 30H,4); 
ELSE  B$BYTE(R$PTR:=R$PTR-1)=CHAR  - 30H; 

END  load$a$char; 


LOAD$NUMBERS : PROCEDURE ( / DDP , CNT ) J 
DECLARE  addr  address,  (i.cnt)byte; 
HOLD-RES (ADDR); 

ctr-cnt; 

DO  INDEX  * 1 TO  CNTJ 
CTR-CTR-i; 

CALL  LOAD$A$CHAR(H$BYTE(CTR)  ); 

end; 

CALL  INCAPTR ( 5) » 

END  LOAD$NUMBERSJ 


SET$LOAD : PROCEDURE  (SIGN$IN); 
DECLARE  S IGN$IN  BYTE? 

DO  CASE  ( CTR : *C$BYTE( 4 ) ) ; 
BASE-.R0J 
BASE- .R 1 > 

BASE-.R2; 

end; 

DEC$PTA(CT3)»C$BYTE(3); 

sign0(ctr)-sign$in; 

CALL  FILL  (BASE, 10,0); 
RiPTR-9? 

switch-false; 
end  set$load; 


LOAD$NUMEBlC:  PROCEDURE; 

CALL  SETUOAD(l); 

CALL  LOAD$ NUMBERS (C$ADDR(0) ,C$BYTE(2) ) ; 
END  LOADtNUMERIC; 


LOAD$NUM$LIT:  procedure; 

DECLARE ( LI T$S IZE .FLAG ) BYTE; 

CHAR$SIGN:  PROCEDURE; 

LIT$SIZE-LIT$SIZE  - 1J 
HOLD-HOLD  ♦ 15 
END  char$sign; 

LIT$SIZS-C$3YTE(2); 

HOLD-Ci ADD3( 0 ) ! 

IF  H$BYTE( 0)-  THEN 

do; 

CALL  CHARTS IGN ; 

CALL  SET$LOAD(NEGITIYE) ; 

end; 
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ELSE  DC? 

IF  H$BYTE( 0 )-"■*■'  THEN  CALL  CHAR$5IGNJ 
CALL  SET$LOAD( POSITIVE) ; 

end; 

FLAG=0? 

ctr=lit$size; 

DC  I NDEX=1  TO  LIT$SIZE; 

CTR*CTR-i; 

IF  H$BYTE(CTR)»'. ' THEN  FLAG=LIT$SI ZE  - (CTR+1); 
ELSE  CALL  LOAD$A$CHAR ( H$3YTE ( CTR ) ) i 

end; 

DEC$PTA(C$BYTE(4))=  FLAG; 

CALL  I NC$PTR ( 5 ) ; 

END  load$num$lit; 


STCRE$ONS:  PROCEDURE; 

IF( SWITCH : =NCT  SilTCH)  THEN 

B$ BYTE( 0 )*SHR( H$3YTE ( 0 ) ,4)  OR  '0 ' J 
ELSE  do; 

HOLD=HCLD-i; 

B$BYTE(0)  = (H$BYTE(  0)  AND  0FH ) OR  'fl'j 

end; 

BASE=3ASS-1? 

END  STCRSiONEJ 


STOREAAS iCHAR : PROCEDURE( COUNT) ; 
DECLARE  CCUNT  BYTE? 

svitch-falsf; 

HOLD5® .R2  ♦ 9? 

DO  CTR=1  TO  COUNT; 

CALL  ST0R2$0NE; 

end; 

end  store$as$cbar; 


SET$ZONE : PROCEDURE  < AD  DR ) ; 

DECLARE  AD DR  ADDRESS? 

IF  NOT  S IGN0 ( 2 ) THEN 

do; 

base=addr; 

BiBYTE(0)*B$3YTE(0)  OR  ZONE; 

end; 

CALL  INCAPTR(4); 

END  setszone; 


SET$SIGN$SEP:  PROCEDURE  ( ADDR  ) »* 
DECLARE  ADDR  ADDRESS. 

base*addr; 

IF  S IGN0 ( 2 ) THEN  B$BYTE (0 ) = ' + ' J 
ELSE  B$BYTE(0 )* 

CALL  I NC$PTR ( 4) J 
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END  SETASIGNAS E?» 

STCREANUMSRIC:  PROCEDURE; 

CALL  checxAdecimal; 

BASE=CAADDR(0 ) 

+ CABYTE(2)  -l; 

CALL  STOREAASACHAR( CABYTE{2) ) J 

END  STOREANUMERICJ 

/****♦  input-output  ACTIONS  *«***#/ 

DECLARE 

1 

- 

EOFAFLAGAOFFSET 

LIT  '36', 

FLAGAOFFSET 

LIT  '33', 

EXTENTAOFFSET 

LIT  '12', 

REC$NO 

LIT  '32', 

» 

PTRAOFFSST 

LIT  '1?', 

n 

buffalfngth 

LIT  '128', 

[ 

VAR$END 

LIT  'CR', 

r 

TERMINATOR 

LIT  '1AH ' , 

n 

HIGHA7  ALUE 

LIT  '0FFH', 

INVALID 

BYTE, 

REWRITEAFLAG 

BYTE  INITIAL  (0H), 

j 

RANDOMAFILE 

BYTE, 

CURRSNTAFLAG 

BYTE, 

FC3A3YTS 

BASED  CURRENTAFCB  BYTE. 

FCBAADDR 

BASED  CURRENTAFCB  ADDRESS, 

FCBAEYTEAA 

BASED  CURRENTAFCB  (1)  BYTE, 

E 1 

fcbaaddraa 

BASED  CURRENTAFCB  (1)  ADDRESS , 

BUFFAPTR 

ADDRESS, 

f 

BUFFAEND 

ADDRESS, 

3UFFSTART 

ADDRESS, 

BUFFABYTE 

BASED  BUFFAPTR  BYTE, 

CONABUFF 

ADDRESS  INITIAL  (80H), 

C0NA3YTS 

BASED  CONABUFF  BYTE, 

CONAINPUT 

ADDRESS  INITIAL  (32H); 

ACCEPT:  PROCEDURE; 

\ 

call  cp.lf; 

[ 

CALL  PRINTACHAROFH); 

/*  CALL  crlf;  V 

CALL  FILL( CONAINPUT ,(C0NABYTE:=CABYTE(2) ) , )J 

> 

CALL  RSAD( CONABUFF) ; 

i 

call  move;ccnAinput,res'CAaddr(0) ) .conabyte); 

CALL  INCAPTR ( 3 ) » 

i 

end  accept; 

i 

240 



1 

DISPLAY:  PROCEDURE? 

DECLARE  B$CNT  BYTE? 

BASE=C$ADDR( 0)* 

IE  NOT  C$BYTE(3)  THEN  CALL  CRLFJ 
B$CNT  = C$3YTE(2); 

DO  CTR  = 0 TO  B$CNT  - 1» 

CALL  PRlNT$CHAR(BiBYTE(CTR)  )J 

end; 

CALL  INC$PTR(4),* 

END  DISPLAY; 


GIT$FILE$TYPE:  PROCEDURE  BYTE? 
BASE*C$ADDR(0); 

RETURN  B$ 3 YTE(FLAG$ OFFSET ) ; 
END  GETiFILE$TYPEJ 


SET$FILE$TYPE : PROCEDURE(  TYPE ) J 
DECLARE  TYPE  BYTE? 

BASE=C$ADD3(0); 

I?  GET$FILE$TYPE<>0  THEN  CALL  FATALAERROR ( 'OE  ' ) ; 

b$byte(flag$offset)=type; 
end  set$file$type; 


SET$I $0 : PROCEDURE; 

invalid-false; 

IF  C$ADDR( 0) -CURRENTS FCE  THEN  RETURN; 

/*  STORE  CURRENT  POINTERS  AND  SET  INTERNAL 
WRITE  HARK  */ 

bass-current$fcb; 

FCBiADDR$A i PTRiOFFSET )=3UFFiPTRJ 
FCB*BYTE$ A ( FLAG$OFFSET )*CURRENT$FLAG  5 
/*  LOAD  NEW  VALUES  */ 

3UFF$END=( 3UFF$START:=( CURRENT$FCB :=C$ADDR (0) ) 
+ START$OFFSET)  + BUFF$LENGTEJ 
CURRENT$FLAG=FCB$BYTS$A(FLAG$OFFSST) ; 
BUFF*PTR=FC3$ADDR$A (PTRSOFFSET ) J 
END  SET$I$OJ 


OPEN$FILS:  PROCEDURE (TYPE ) J 
DECLARE  TYPE  BYTE; 

CALL  SET$FILE$TYPE( TYPE  ) ; 
CTR-OPEN(CURRENTiFC3:-C$ADDR(0)  ); 

DO  CASE  TYPE-1? 

/*  INPUT  */ 

do; 

IF  CTR-255  THEN  CALL  FATAL$ERROR( 'NF'  )J 

end; 

/*  OUTPUT  */ 

do; 
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CALL  delete; 

CALL  MAKE(C$ADDR(0) ) ; 

end; 

; /*  CASE  2 NOT  OS  ED  */ 

/*  1-0  */ 
do; 

IF  CTR=255  THEN  CALL  FATAL? ERROR ( 'NF'  )J 

end; 

end; 

FC3?BYTE?A (EXTENT?OFFSET )=0J  /*  SET  THE  EXTENT  FIELD 

IN  FCB  */ 

FC3?BYTE?A (REC?NO)=0?  /*  SET  THE  RECORD  NUMBER 

IN  FCB  */ 

FCB?3YTE?A(ECF?FLAG$OFFSET)=FALSE; 

/*  SET  THE  EOF  INDICATOR  OFF  */ 
BCFF?END=(  3UFF?S  TART:  = ( CURF.ENT?FCB  + ST ART$OFFSET ) ) 

+ buff?length; 

CURRENT?FLAG=FC3?3YTESA(FLAG?CFFSET) ; 

3UFF?PTR ,F  CB?  ADDF? A ( PTP.?OFFSFT  ) =3UFF$START“1  ? 

CALL  INCSPTR (2  ) ; 

END  OPEN?FILE? 


*P.ITE?MARK:  PROCEDURE  BYTE; 

RETURN  ROL (CURRENT? FLAG  , 1 ) ; 

END  weitesmark; 


SET?WPI TE?MARK : PROCEDURE; 

CURRENTS FLAG-CURRENT? FLAG  OR  30HJ 
END  SET?VRITE?MARX; 


VRI TE?RECORD : PROCEDURE; 

CALL  set$dma; 

CURRENT?FLAG=CUP.?.ENT?FLAG  AND  0FHJ 
IF  ( CTR :=DISK?«RITS)  =?  THEN  RETURN; 
CALL  PRINT$ERRCR( ''#3'); 

invalid*t?.ue; 

END  WRITS$RECORD; 


READ? RECORD:  PROCEDURE; 

CALL  set?dma; 

IF  «RITE?MARK  THEN  CALL  ¥RITE?RECCRD J 
I?  ( CTR:=DISE?READ)=0  THEN  RETURN? 

IF  CTR=1  THEN  FC3?E YTE? A( ECF?FLAG ?OFFS ET )=TRUE J 

invalid«true; 

END  READSRECORD; 


READ? BYTE:  PROCEDURE  BYTE? 

IF  ( BOFF?PTR :*3UFF$PTR  + 1 ) >=  BUFFEND  THEN 

do; 

l 

i 

. 
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CALL  read$record; 

IF  FCB$EYTE$A(EOF$FLAG$OFFSET)  THEN 
RETURN  TERMINATOR} 
3UFF$PTR=3UFF$STA?T; 

end; 

RETURN  3UFF$BYTE; 

END  READ<3YTE; 


*RITE$BYTZ;  PROCEDURE  (CHAR); 

DECLARE  CHAR  BYTE? 

IF  ( BUFF$?TR :=BUFF$PTR+1 ) >=  3UFF$2ND  THEN 


call  writesrecore; 

BtIFF$PTR  = 3UFF$  START? 
IF  RE«RITE$FLAG  THEN 


CALL  rsad$record; 
FCP$BYTE$A(REC$NO)=FCB$EYTE$A( 


end; 

end; 

CALL  SET$WRITE$MARE 
3JF?$3YTE=CHAR; 

END  WPITEiBYTE; 


«RITE$END$MA?.K  : PROCEDURE 
CALL  W?.ITE$BYTE(CR) 
CALL  WRITESBYTE(LF) J 
END  •RITESENT^ARX; 


FZADSZNDiMARJ:  PROCEDURE; 

IF  READ^BYTEOCR  TEEN  CALL  PRINT$ER?CR  ( 'EM' ) 
IF  R?Ar$3YTEOLF  THEN  CALL  PHI NT$ERROS  'EM  ' ) 

end  ?.ead$end*m»fk; 


READiVARl ABLE: PROCEDURE; 

CALL  SETtltC; 

EASE=C$ADDR( 1 ) ; 

EC  A$CTR-0  TO  CiADDR(2)-i; 

IF  (CTP :»(BiBTTE( A$CTP)  :*READiBYTE)  ) = V ARi END  THEN 

do; 

ctr*rbadS3yte; 

return; 

end; 

IF  CTR=TERMINATCR  THEN 


FCB $B YT E$ A ( EOFt FLAG £ OFFSET ) =TKU 

return; 


end; 

end; 

CALL  RSAD$END$MARK 


;nt  rsad$?ahia3Lb; 


WRITEAVARIABLE:  PROCEDURE? 

DECLARE  COUNT  ADDRESS; 

CALL  SST$ISC; 

BASE=CAaDDR(  1 ) * 

C0UNT=C$ADDR(2); 

DO  WHILE ( 3 $3 YTE ( COUNT :=C CUNT-1 )<> ' ' ) AND  (COUNTO0); 

end; 

DC  A$CTP.=0  TO  COUNT; 

CALL  WRITE$BYTE(3A3YTE(A$CTR ) )J 

end; 

CALL  WRITEASNDAMARK; 

END  WRITEAVAR IABLE* 


READATOA MEMORY:  PROCEDURE; 

EASE=CAADDR(l)  J 
DC  AACTR=0  TC  C$AEDR(2)-i; 

IF  (BAbYTE(A$CTR) : =READA3YTE ) = TER MI  NATOS  THEN 

do; 

FCBABYTEAAv SOFA  FLAG AOFFSET)=TRUEi 
return; 

end; 

end; 

CALL  READAINDAMARK; 

END  READ  $ TO $ MEMORY; 


*R ITEAFROMA MEMORY  : PROCEDURE; 

3ASE=C$ ADDR( 1 ) ; 

DO  AACTR=0  TO  C$ADDR(2)-i; 

CALL  WP.ITE$BYTE(B*BYTS(  A$CTR)  )J 

end; 

CALL  writeaendamark; 

END  WPITEAFR0M$MEM0RY; 


/*  * * * * RANDOM  1-0  PROCEDURES  * * * V 


SET A RAN DOM A PO I NTEP. : PROCEDURE  i 
/* 

THIS  PROCEDURE  READS  THE  RANDOM  KEY  AND  COMPUTES 
WHICH  RECORD  NEEDS  TC  BE  AVAILABLE  IN  THE  3UFFSR 
THAT  RECORD  IS  MADE  AVAILABLE  AND  THE  POINTERS 
SET  FOR  INPUT  OR  OUTPUT 

*/ 

DECLARE  ( BYTE ACOUNT .RECORD ) ADDRESS, 

EXTENT  BYTE; 

IF  WRITEAMARK  THEN  call  writearecord; 

BYTE ACOUNT*( C$ ADDR( 2) +2 )*( CONVERT  AT 0$ HEX ( C$ADDR(3) 
.CABYTE(e) )-l); 
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RECORD=SER  (BYTE$COUNT  ,7  ) ; 

EXTENT=SE? ( RECORE,?  ) J 

IF  EXTENT< >FCB$BYTE$A ( EXTENT$OFFSET)  THEM 

do; 

CALL  CLOSF(CiADDR(0) ) f 
FC3$BYTE$A(EXTENT$0FFSET)=EXTENTJ 
IF  OPEN ( C$ADDR (0 ) )<>0  THEN 

do; 

IF  SHR ( CURRENT$FLAG, 1 ) THEN  CALL  MAXE( C$ADDR(0) ) J 

ELSE  invalid=true; 
end; 

SN  D J 

BUFF$PTR=( BYTS$COUNT  AND  7FE ) + BUFFASTART  -If 
FCB$BYTE$A (32 )=LOW( RECORD)  AND  7FH? 

CALL  read$record; 

END  set$randcm$pcintsr; 

GET$REC$ NUMBER : PROCEDURE  ADDRESS  » 

DECLARE  (RECORD, LOG ICAL SR EC$NUM,BYTE$ COUNT)  ADDRESS? 
REC0RD=SHL(?CB$3YTE$A(SXTENT$0FFSET)  ,7) 

+ FCB$BYTE$A(REC$NO  )f 

IF  NOT  SHR  (CURRENTS FLAG  , 1 ) TEEN  RECORD=RECORD-l  i 
BYTE$CCUNT=SHL (RECORD ,7 ) + ( ( BUFFApTR+l ) -BUFFS ST ART ) 
L0GICALSREC$NUM=(BYTE*C0UNT/(C$ADD?.(2)+2)  )+i; 

RETURN  LOG  I CAL$R  ECS  NUM  ? 

END  GET$REC$NUMBERJ 

SET$RELATI7E$XIY:  PROCEDURE,* 

DECLARE  (REC^NUM,  K ) ADDRESS, 

;i,CNT)  BYTE, 

J ( 4 ) ADDRESS  DATA  (10000,1000,100,10), 

BUFF ( 5 ) BYTE! 

rscsnum=get$rsc$ number; 

DO  1 = 0 TO  3,* 

CNT=0J 

DC  taHILS  RSCiNUM>=(K:=J(I ) ); 

rec$num«rec$num  - s; 

CNT=CNT  + l; 

end; 

3UFF( I)=CNT  + '0',* 

end; 

BUFF ( 4) =REC$NUM+  '0  ' J 

IF  ( I:«C$9YT?(8) )<=5  THEN 

CALL  MOVE ( .3UFF+5-I  ,C$ADDR(3)  ,1  ),* 

ELSE  do; 

CALL  FILL( Ci ADDR( 0) ,1-5,  ' '); 

CALL  MOVE ( . BUFF, CA ADDR( 3 ) +1-6 , 5); 

END? 

END  S2T$RELATI7E$KEY; 

WRI TE$ EMPTY S RE CORD : PROCEDURE? 

DO  A$CTR=1  TO  C$ADDR(2) J 

CALL  WRITE$BYTE(HIGHSVALUE); 

end; 
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CALL  WRITEAENDAMARK; 
ENT  WRITEAEMPTYARECORD; 


WRITEADUMMYARECORDS  : PROCEDURE(DIFFEP.ENCE  ) 5 
DECLARE  DIFFERENCE  ADDRESS,  COUNT  BYTE; 

DO  C OUNT=l  TO  difference; 

CALL  WRITEA  EMPTY  AP-ECORD; 
end; 

END  WRITEADUMMYARECORDS? 

BACKAONEA EXTENT:  PROCEDURE? 

CALL  CLOSS(C$ADDR(0)); 

IF  FCBABYTEAA(EXTENTAOFFSET) := 

FCBABYTEA A(EXTENTAOFFSET ) -1=255  THEN 
CALL  FATAL$ERROR ( 'W7 ' ) ; 

IF  OPEN ( C A ADDR (0 ) )<>0  THEN 

do; 

CALL  PRINTAERRO?.!  'OP'); 

invalid-true; 

return; 

end; 

FC3A3YTEAA ( RECAnO  ) = 127J 
END  BACKAONSAEXTENTJ 

BACKAONEAftECORD:  PROCEDURE; 

IF( BUF?$PTR : =BUFF$PTR-( CA ADDR( 2 ) +2 ) ) >=BUFF$ START- 1 THEN 

do; 

?CB$BTTE4A(BBC$N0)«FCB$BY?EAA(RECAN0)-1; 

return; 

end; 

BU?FA?TR=BUFFAEND-(BUFFASTART-BUFFAPTR) ; 

IF  ?CBABYTEAA(RECANC)=0  THEN 

do; 

call  backaonsAextent; 

IF  INVALID  THEN  RETURN  J 

CALL  readarecord; 
call  backaonsaextent; 
end; 

ELSE 

do; 

FCBABYTEA A(RECAnO)=FCBA3YTEAA(R EC ANO  )-2{ 

call  readarecord; 

FCBABTTEAK RECANO  )=FCBABYTEAA(  RECANO )-l; 

end; 

end  backaonearecord; 

REWRI TEA  SEQ : PROCEDURE!  FLAG  ) ; 

DECLARE  FLAG  BYTE? 

call  bacxaonearecord; 
rewri  teaflag=*true; 

IF  FLAG  THEN  CALL  *R ITEAFRCMAMEMORY J 

/*  THIS  IS  A REWRITE  */ 

ELSE  CALL  WRITEAEMPTYARECORD;  /*  THIS  IS 

A DELETE  */ 
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CALL  writeSpecord; 

FCB$BYTE$A(REC$NO) =FCB$BYTE$A ( REC$NO ) -1 ; 

rewrite$flag=false; 
call  read$record; 
end  rewrite$seq; 

CHECK$DIFFERENCE:  PROCEDURE; 

DECLARE  (DIFFERENCE, NEXT$RECORD,NEXT$KEY)  ADDRESS? 
NSXTSRSCORD=GET$REC$ NUMBER; 
NEXT$KEY=C0NVERT$T0$HEX(C$ADDR(3),C$BYTE(3)  ) J 
IF  NSXT$RECORD  > NEXT$KEY  THEN  CALL  FATAL$ERROR( 'V2' ) i 
DI FF5hENCE  = NEXT$ KEY-NEXT A RECORD  J 
IF  DIFFERENCE  > 0 THEN 
CALL  VR I TES DUMMY $ RECORDS (DIFFERENCE)  ? 

END  CHECXSDIFFERENCEJ 

/#***#**  *0VES  *******/ 


INCSHOLD:  PROCEDURE; 
HOLD=HOLD  ♦ 15 
CTR=CTP  + i; 
s END  INCSHOLD? 

lcadsinc:  procedure; 

H$3YTE(0)=3SBYTE(0) J 
BASE*BASE+1 ? 
CTR1=CTR1  + 1? 

CALL  INCSHOLD? 

END  LOADSINCJ 


CHECK$SDIT : PROCEDURE(CHAR) J 
DECLARE  CHAR  BYTE? 

IF  (CHAR«'0'J  OR  (CHAR*'/')  THEN  CALL  INCSHOLD? 

ELSE  IF  CHAR='3'  THEN 
DO! 

H$BYTE(  0 ) = ' '? 

CALL  INC$H0LD? 

end; 

ELSE  IF  CH  AR  = 'A  ' THEN 

do; 

IF  NOT  LETTER ( B$BYTE( 0 ) ) TEEN  CALL  PR lNTASRROR( ' IC ' ) ? 


/#***#*  MACHINE  actions  * **♦**/ 


STOP:  procedure; 

CALL  PRINT( . ( 'END  OF  JOB  $')); 
CALL  booter; 
end  stop; 


/a**************** 

THE  PROCEDURE  BELOW  CONTROLS  THE  EXECUTION  OF  THE  CODE. 
IT  DECODES  EACH  OP-CODE  AND  PERFORMS  THE  ACTIONS 

a*#*##*#***#**#***/ 


EXECUTE:  PROCEDURE* 

j do  forever; 

DO  CASE  get$op$code; 

. * /*  CASE  ZERO  NOT  USED  */ 

I 

/*  Cl:  ADD  */ 

CALL  ADD; 

/*  02:  SUB  */ 


[ 


do; 

CALL  COMPLIMENTS)  ; 

IF  S IGN0( 0 ) TEEN  S IGN0 ( 0 ) = NESITIVE  ; 

ELSE  SIGN0(0)=POSITIVE; 

CALL  add; 

end; 

/*  03:  MUL  *t 

do; 

DECLARE  I BYTE* 

CALL  SET$MULT$DI7J 
DECPT1,DECPT2=DEC?T1  ♦ DECPT3? 

CALL  ALLIGNJ 

CALL  MULTIPLY ( SHR { ?.1(  I :*9)  ,4)  ); 

DO  INDEX=1  TO  9,* 

CALL  MULTIPLY ( R1 ( I :=I-1 ) AND  0F5); 
CALL  MULTI?LY(SHR(R1(I)  .4)); 

END? 

end; 

/*  04:  DI V ♦/ 


CAL3 


divide; 
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/*  05:  NSG  */ 


3RANCH$FLAG»N0T  BRANCH$FLAGJ 
/*  06:  STP  */ 

CALL  stop; 

/*  07:  STI  */ 

CALL  store$immediate; 


/*  09:  RND  */ 

do; 

call  store$immediate; 
CALL  FILL ( .R2,10,0)J 
R2(9)*i; 

CALL  ADD; 

end; 

/*  09:  RET  */ 


do; 


end; 


IF  CAADDR(0)<>0  THEN 

do; 

A$  CTR=C$  ADDP.  ( 0 ) » 

C$  ADDR ( 0 ) =0  J 
PROGRAM$COUNTE?.=AiCTR » 

end; 

ELSE  CALL  INC$PTR'2)J 


CALL  SET$I<OJ 
IF  *RITS$MARK  THEN 

do; 

IF  NOT  SHR( CURRENT AFLAC ,2  ) THEN 
CALL  WRITE$3YTE( TERMINATOR)  ; 
CALL  WRlTE$RSCOap; 

end; 

ELSE 

CALL  sst$dma; 

CALL  CLOSE ( C$ADDR( 0 ) ) ; 

FC3$BYT  E$A( FLAGSOFFSET ) =0 ; 

CALL  INC$PTR(2); 


r 
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IF  OVERFLOW  TEEN  PROG RAM$ COUNTER 
= C$ADDR(0)5 
ELSE  CALL  INC$PTR(2); 

end; 

/*  12:  BRN  */ 

PROGRAM$COUNTER=C$ADDR(0)J 
/*  13:  OPN  */ 

do; 

CALL  OPENiFILE(l  ); 

CALL  READ$RECORr; 

end; 

1 /♦  14:  OP1  */ 

CALL  0PEN*FILE(2)J 
/♦  15:  0P2  */ 

f do; 

\ /+  4 IS  USED  SO  EACH  TYPE  SETS  ONLY 

ONE  BIT  IN  CU?RENT$FLAG  */ 

CALL  OPEN$FILE(4); 

CALL  READiRECORD; 

i 1 end; 

/*  16:  RGT  */ 

dc  ; 

IF  NOT  SIGN0(2)  THEN 

BRANCH$FLAG*NOT  BRANCHSFLAGJ 
CALL  COND$3RANCH(0)  J 

end; 

/*  17:  RLT  */ 

do; 

IF  S IGN 0( 2 ) THEN 

BR ANCH$FLAG*NOT  BRANCH$FLAG J 
CALL  COND$ BRANCH ( 0 ) J 

end; 


/*  16:  REO  */ 


CALL  INCR$0R$3RANCH( INVALID)? 

/*  20:  EOR  */ 

CALL  INCR*ORiBRANCH(?CB$BTTE$A(EO?$FLAG$OFFSET) ) ; 
/♦  21:  ACC  */ 

CALL  accept; 

/*  22:  STD  */ 

do; 

C$BYTE( 3) =0 ; 

CALL  display; 
call  stop; 

end; 

/*  23:  LDI  */ 

do; 

C$ADDR ( 2) =CON VE?T$TO$HEE ( C$ADDR ( 0 ) 
,C$BYTE(2) )+l ; 

CALL  INC$?TR(3); 

end; 

/*  24:  DIS  ♦/ 

CALL  display; 

/*  25:  DEC  */ 

do; 

IF  C$ ADDR(  0 )<>0  THEN  C$ADDR(0) 

= C$ ADDR ( 0 )-l ; 

IF  C$ADDR ( 0 ) -0  THEN 

P50GP.AM$  COUNTER  = C$ADDR(1); 

ELSE  CALL  INC$PTR(4); 

end; 

/*  26:  STO  */ 

do; 

call  storesnumeric; 

CALL  INC$PTR(4); 

end; 

/*  27:  ST1  */ 

do; 

CALL  STORE$NUME?IC; 

CALL  SET$ZCNE ( C$ADDR( 0 ) ) ; 


end; 


r r 


/*  33:  LEI  <7 

CALL  LOAD^NUMERIC; 

/*  34:  LD2  */ 

do; 

HOLD*C$ADDR( 0) » 

I?  CHECK$FOR$S IGN ( H$BTTE( 0 ) ) THEN 

do; 

CALL  SET$LO AD (POSITIVE); 

CALL  LOAD$ NUMBERS ( C* ADDR( 0) ,C$BYTE(2) ) ; 

end; 

ELSE  do; 

CALL  SET$LOAD(NEGITIVE); 


CALL  LO AD $ NUMBERS ( C$ADDR  ( 0 ) -*-1 
,C$BTT?(2)-l)i 

CALL  LO AD $ A$ CHAR (H$BYTE(0) -ZONE) » 

END? 

end; 

/*  35:  LD3  */ 


do; 

DECLARE  I BYTE; 

HOLD«C$ADDP.(0); 

IF  CHECK$FOR$SIGN ( CTR :®H$BYTE( I :* 

CiBYTE ( 2 )-l ) ) THEN 

do; 

CALL  SET$LOAD(POSITI VE) ; 
i*n-i; 

end; 

else  do; 

CALL  SET$LOAD(NEGITIVE) ; 

CALL  LOAD$A$CHAR(CTR-ZONE)J 

end; 

CALL  LOAD$NUMBERS(C$ALDR'0) ,1); 

end; 

/*  36:  LD4  */ 

do; 

HOLD=C$ADD3(0); 

IF( H$BYTE( 0 )='+')  THEN  CALL  SET$LOAD(l); 
ELSE  CALL  SET$LOAD(0)J 

CALL  LO AD $ NUMBERS  fC$ADDR(0) ,C$BTTE(2)  -1 ) ; 

end; 

/*  3?:  LD5  */ 


do; 


end; 


HOLD=CiADDH(0); 

IF  H$BYTE( C$3YTE( 2 ) - 1)  = ' + ' THEN 
CALL  SET$LOAD(l); 

ELSE  CALL  SET$LOAD(0)J 

CALL  LO AD $ NUMBERS ( C$ADDR ( 0 ) ♦ C$BYTE( 2 )-l ) ; 


/*  33:  LD6  */ 

do; 

DECLARE  I BYTE; 

HOLD=C$ADDR(0)J 

CALL  SET4LOAD(H$BYTE( I :*C$BTTE(2 )-l ) ) ; 
BASE=BASS  ♦ 9 - I; 

DO  CTR  * 0 TC  i; 

B$ BYTE ( CTR )*H$BYTE( CTR); 

end; 

B$3YTE( CTR)*BS3YTE( CTR ) AND  0F0H? 


*• 
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CALL  INC$PTR(5); 

end; 

/*  39:  PEP.  */ 

do; 

BASE=C$ ADD?  ( 1 ) +1 J 
B$ADDR(0)=C$ADDR(2); 

program$counter=c$addr(0) ; 

end; 

/*  40:  CNU  */ 

CALL  cckp$num$unsigned; 

/*  41:  CNS  */ 

CALL  COMP$NUM$SlGN; 

/*  42:  CAL  */ 

CALL  comp$alpha; 

/*  43:  RWS  */ 

dc; 

CALL  SET$IiO; 

IF  NOT  SHR(CURRENT$FLAG,2)  THEN 
CALL  FATAL$EaROR( 'W6')? 

IF  NOT  FCB$BYTE$A( EOF$FLAG$OFFSET)  THEN 
CALL  RSViRI  TE$  SEQ ( 1 ) » 

CALL  INC$PTR(6); 

end; 

/*  44:  DLS  V 

do; 

CALL  SET$I$0; 

IF  NOT  SHR (CURRENT$FLAG , 2 ) THEN 
CALL  FATAL$ERRCR(  '¥6')J 
IF  NOT  FCB$BYTE$A(EOF$FLAG$OFFSST)  THEN 
CALL  RE¥RITS$SEQ(0) ; 

CALL  INC$PTR(6)5 
end; 

/*  45:  RDF  */ 

DC? 

CALL  SET$IiOJ 
IF  NOT  CURRSNT$FLAG  THEN 
CALL  FATAL$BRROR('W5')5 
IF  NOT  FCB$BTTE$A( EO?$FLAG$OFFSET ) THEN 
CALL  read$to$memory; 

CALL  INC$ PTR( 6 ) } 

I r.  i 
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? 
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/*  46:  WTF  */ 

do; 

CALL  SET$I$OJ 

I?  NOT  SHR( CURRENT£FLAG,1)  THEN 
CALL  FATAL$ERR0R('W3'); 

CALL  WR ITE$FROM$ MEMORY » 

CALL  INC$PTR(6); 

END; 

/*  47:  RVL  */ 

CALL  READ$VARIABLEJ 
/*  48:  ¥VL  */ 

CALL  write$variable; 

/*  49:  SCR  */ 

do; 

SUBSCRI P? ( C$3YTE( 2 ) )» 

CONVE?.T$TO$HEX(C$ADDR  (?)  ,C$BYTS(3) ) ; 
CALL  IN C$PTR (4 ) J 

end; 

/*  50:  SST  */ 

CALL  STRI NG$ COMPARE ( 1 ) J 
/*  51:  SLT  */ 

CALL  STRlNGiCOMPARE(0); 

/*  52:  SEO  */ 

CALL  STRINGS COMPARE ( 2 ) J 
/*  53:  MOV  */ 

do; 

CALL  MC?E(RESIC$ADDR(1) ),R1S(C4ADDR(0)) 

,C$ ADDR( 2 ) ) J 

I?  C$ADDR(3)<>0  THEN  CALL 

FILL ( RES ( CSADDR ( 0 ) ) ♦ C$ADDR(2) 
,C$ADDR(3),'  '); 

CALL  INC$PTR(9); 

end; 

/*  54:  RF.S  */ 

do; 
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CALL  SET$I$0,* 

I F SHE ( CURRENTS  FLAG , 1 ) THEN 
CALL  PATAL$ERRORl  ''45' ) ? 

IT  NOT  FCB$BTTE$A(EOF$FLAG$OFFSET)  THEN 

do; 

CALL  set$relative$ket; 
call  read$to$memory; 

end; 

call  inc$ptr(9); 

end; 

/*  55:  MRS  */ 

do; 

CALL  SET$I$0; 

IF  NOT  SHR{CURR£NT$FLAG,1 ) THEN 
CALL  FATAL$ERROR(  'Ml'); 

CALL  checudifference; 

CALL  set$relative$ket; 
call  write$fromamemory; 

CALL  INC$PTR(9); 

end; 

/*  56:  RRR  */ 


end; 

/*  57:  WRR  */ 


CALL  SET$I$OJ 

IF  SHR( CURRENT$FLAG ,1 ) THEN 
CALL  FA TAL$ ERROR ( 'W5' ) » 

CALL  set$random$pointer; 

IF  NOT  INVALID  THEN  CALL  READ$TO$ MEMORY? 
IF  VALID  THEN 

FCB$BYTE$A( EOF$FLAG$OFFSET )=FALSE? 

CALL  INC$PTR(9)J 


DECLARE  DIFFERENCE  ADDRESS,* 

CALL  SET$I$OJ 

IF  SHR(CURRENT$FLAG,1)  THEN 

do; 

CALL  CHECE$DIFFERENCE; 

call  set$relativs$key; 
call  writs$from$memory; 
end; 

ELSE 

do; 

IF  SHR(CURRENT$FLAG,2)  THEN 

do; 

call  set$random$pointer; 

IF  NOT  INVALID  THEN 

do; 

IF  ( .BUFF$PTHn)*HIGH$YALUE  THEN 
DO; 


rewrite$flag=true; 

CALL  WRITS*FR0M*MEM0RY5 
rewrite*flag=false; 

END; 

ELSE 

CALL  PRINT*ERR0R(  'W4 ')i 

end; 

ELSE 

CALL  FATAL$ERROR( 'W3'K 

end; 

end; 

CALL  INC$PTR(9); 

end; 

/*  58:  RWR  */ 

do; 

CALL  SET$I$0; 

IF  NOT  SHR(CURRENT$FLAG,2)  THEN 
CALL  FATAL*EKROR( 'W6')» 

REWRITE* FLAG»TRUE; 

CALL  BACK*ONE*RECORDJ 

IF  NOT  INVALID  THEN  CALL  WP.ITE*?ROM*MEMORY; 

rewrite$?lag=false; 

CALL  INC$PTR(9); 

end; 


/*  59:  DLR  */ 


do; 

CALL  SET*I$0; 

I?  NOT  SHR( CURRENT* FLAG, 2)  THEN 
CALL  FATAL*ERRCR('W6'); 

call  set*random* pointer; 
rewrite$flag=true; 

IF  NOT  INVALID  THEN 

CALL  write$empty*record; 
REWRITE*FLAG=FALSS; 

CALL  INC*PTR(9)J 

end; 

/*  60:  MED  */ 

do; 

CALL  MOVE( C$ ADDR ( 3 ) , RES ( C* ADDR ( 0 ) ) 
,C*ADDR(4)); 

base=res(c$addr(D); 

hold-res(c*addr(0)); 

CTR*0; 

C TR1 =0 ; 

DO  WHILE  ( CTR<C*ADDR(2 ) )AND(CTR 
< C* ADDR ( 4 ) ) J 

CALL  CHECK* BD IT( H$BYTE(0  )) ; 
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end; 


I?  CTR  < C$ ATDR( 4 ) THEN 

CALL  ? I LL ( HOLD ( C $ ADDR ( 4 ) -CTR , ' '); 
CALL  INC$PTR(10); 

end; 

/*  61:  MNE  */ 

? /*  NULL  CASE  ♦/ 


/*  62:  GDP  */ 


do; 

DECLARE  OFFSET  BYTE; 

0 FFSET5* CON  VERT $TO$HEX(  C$ADDR(  1)  ,C$BYTE(  1 )-l ) 
IF  OFFSET  > C$BYTE(0)  + 1 THEN 

do; 

CALL  PRI NT$ERROR ( 'GD ' ) J 

CALL  INC$PTR(SHL(C$BYTE(0) ,1)  + 5); 

end; 

ELSE  PROGR AM $COUNTER=C$ADDR( OFFSET  + 2); 

end; 

END;  /*  END  OF  CASS  STATEMENT  */ 

END;  /*  END  OF  DO  FOREVER  V 

END  execute; 

/******  PROGRAM  execution  starts  here  * * * */ 

base=code$start; 
program$counter=b$addr ( 0) ; 

CALL  execute; 
end; 
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READER 


do; 

/*  COBOL  COMPILER  - PART  2 READER  */ 

/*  THIS  PROGRAM  IS  LOADED  IN  WITH  THE  PART  1 PROGRAM 
AND  IS  CALLED  WHEN  PART  1 IS  FINISHED.  THIS  PROGRAM 
OPENS  THE  PART2.COM  FILE  THAT  CONTAINS  THE  CODE  FOR 
PART  2 OF  THE  COMPILER,  AND  READS  IT  INTO  CORE.  AT 
THE  END  OF  THE  READ  OPERATION,  CONTROL  IS  PASSED  TO 
THE  SECOND  PART  PROGRAM.  */ 


/*  3100H:  LOAD  POINT  */ 

DECLARE 

START  LITERALLY  '100H', 

/*  STARTING  LOCATION  FOR  PART2  */ 

ADR  ADDRESS  IN ITIAL( ST ART ) , 

FCB  (33)  BYTE 

INITIALS,  'PAPT2  COM ',0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0,0), 

INITIALS,  'PART2  COM ',0,0, 0,0, 0,0, 0,0, 0,0, 0,0,0 

,0,0, 0,0,0, 0,0,0), 

i address; 

MONl:  PROCEDURES, A)  EXTERNAL? 

DECLARE  ? BYTE,  A ADDRESS; 

END  MONl,* 


M0N2:  PROCEDURES, A)3YTE  EXTERNAL; 

DECLARE  F BYTE,  A ADDRESS? 

END  M0N2J 


BOOT:  PROCEDURE  EXTERNAL; 

end; 

OPEN:  PROCEDURE  (FCB)  BYTE? 
DECLARE  FCB  ADDRESS? 
RETURN  M0N2  (15,  FCB); 
end; 


READ: 


PROCEDURE  (ADDR)  BYTE? 
DECLARE  ADDR  ADDRESS? 
CALL  MONl  (26,  ADD?)? 
RETURN  M0N2  (20,  .FCE ) 

end; 


/* 


SET  DMA  ADDRESS  */ 
/*  READ,  AND  RETURN 
ERROR  CODE  */ 


ERROR:  PROCEDURE (CODE); 

DECLARE  CODE  ADDRESS? 

CALL  M0N1(2, (HIGH(CODE) ))? 
CALL  MONl ( 2 , ( LOW ( CODE ) ) )5 
CALL  TIME ( 10 ) ; 
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CALL  eoot; 
end  error; 

CALL  MON1  (26,  0100H).* 

/*  OPEN  PASS2.COM  */ 

IF  OPEN( .FCB )=255  THEN  CALL  ERR0R('02'); 

/*  READ  IN  FILE  V 

I * 0100HJ  /*  INITIAL  ADDRESS  */ 

DO  WHILE  READ(I)  * 05  /*  READ  1 SECTOR  */ 

1=1-*-  oeeeH;  /*  bump  dma  address  */ 

end; 

CALL  MONl  (26,  0080H);  /*  RESET  DMA  ADDRESS  */ 

CALL  adr; 


end; 


BUILD: 

do; 

/*  NORMALLY  ORG'ED  AT  100H  */ 

/*  THIS  PROGRAM  TAKES  THE  CODE  OUTPUT  FROM  THE  COBOL 
COMPILER  AND  BUILDS  THE  ENVIRONMENT  FOR  THE  COBOL 
INTERPRETER  */ 


DECLARE 


! 


LIT 

LITERALLY 

'LITERALLY ' , 

BOOT 

LIT 

BDOS 

LIT 

'5', 

TRUE 

LIT 

'1\ 

FALSE 

LIT 

'0', 

FOREVER 

LIT 

'WHILE  TRUE'  , 

FCB 

ADDRESS 

INITIAL  (5CH ) , 

FCBSBYTE 

BASED 

FCB 

BYTE, 

FCBSBYTESA 

I 

BASED  FCB 
BYTE, 

(33) 

BYTE, 

ADDR 

ADDRESS 

INITIAL  ( 100H ) 

CHAR 

BASED 

ADDR 

BYTE, 

BUFFS  END 

LIT 

'100H' , 

INTERPSFCB 

(33) 

BYTE 

INITIAL(0, 'CINTERP 

CODESNOT $SET 

BYTE 

INITIAL  (TRUE), 

READER$ LOCATION 

INTERPSADDRESS 

INTERP$C0NTSNT 

ISBYTS 

CODESCTR 

CSBYTE 

BASE 

3$ ADDR 

3$BYTE 


LIT 

ADDRESS 
B ASED 
BASED 
ADDR ESS, 
BASED 
ADDRESS, 
BASED 
BASED 


'1C80H', 

I NI TIAL ( 2000H ) 
INTEPP$ADDRESS 
INTERP5ADDRSSS 


ADDRESS, 
(2)  BYTE, 


CODE$CTF.  BYTE, 


BASS 

BASE  (4) 


ADDRESS 

byte; 


MON1:  PROCEDURE  (F,A)  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 
END  MON1? 


M0N2 : PROCEDURE  (F.A)  BYTE  EXTERNAL? 

DECLARE  F BYTE,  A ADDRESS? 

END  M0N2? 


PRINTSCHAR:  ?ROCEDURE( CHAR ) 5 
DECLARE  CHAR  BYTE? 

CALL  MON1 ( 2, CHAR ) J 
END  PRINT$CHAR? 


CRLF:  PROCEDURE? 
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CALL  PRINT$CHAR(13) J 
CALL  PHI NT$CEAR( 10) J 
2ND  CRLFJ 


PRINT:  PROCEDUPF(A); 
DECLARE  A ADDRESS; 
CALL  CRLFJ 
CALL  MON1 ( 9 , A ) J 

END  print; 


OPEN:  PROCEDURE  (A)  BITE* 
DECLARE  A ADDRESS; 
RETURN  MO  N 2 ( 1 5 , A ) ; 

END  open; 

REBOOT:  PROCEDURE; 

ADDR  * boot;  call  addr; 
end  reboot; 


MOVE:  PROCEDUP.E(  FROM , DEST,  COUNT); 

DECLARE  (FROM,  DEST,  COUNT)  ADDRESS, 

(F  BASED  FROM,  D BASED  DEST)  BYTE 
DO  WHILE( COUNT : ®COUNT-l )<>0FFFFH* 

d=f; 

FROM=FRCM*l ? 

DBST-DEST+l; 

end; 
end  move; 


GETSCHAR : PROCEDURE  BYTE; 

IF  ( ADDR :=ADDR  * 1)>*BUEF$END  THEN 

do; 

IF  M0N2 ( 20 , FCB  X >0  THEN 

do; 

CALL  PRINT( . ( 'END  OF  INPUT 
CALL  reboot; 

end; 

ADDR»SeH; 

end; 

RETURN  CHAR; 

end  getachar; 


NEITSCHAR:  PROCEDURE; 

char«get$char; 
end  nextschar; 


STORE:  PROCEDURE (COUNT) J 
DECLARE  COUNT  BYTE? 
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IF  CODE$NOT$SET  THEN 

do; 

CALL  PRINK  .('CODE  ERR0R$  ' ) ) 5 
CALL  NEXTiCEAR  * 

return; 

end; 

DO  1*1  TO  count; 
c$byte=char; 
call  next$char; 

CODE$CTR=CODE$CTR+i; 

end; 

end  store; 


BACK$STU?F : PROCEDURE; 

DECLARE  (HCLr, STUFF)  ADDRESS; 
BASS*. hold; 

DO  1*0  TO  3J 

3$BYTE(I )*OET$CEAR; 

end; 

do  forever; 
bass=hold; 
eold=b$addr; 
b$addr=stuff; 

IF  HOLD=0  THEN 

do; 

call  next$chaf.; 
return; 

end; 

end; 

end  back$stu?f; 


STARTSCODE:  PROCEDURE; 

code$not$sit*false; 

i$byte(0)*get$char; 

liBYTE(l)*GETiCHAR; 
CODS$CTR  = INTSRP$ CON  TENT 

call  nsxtschar; 

END  starKcode: 


GOSDEPENDING:  PROCEDURE? 
CALL  STORE(l); 

CALL  STORE(SHL(CHAR.l ) 

end  gcsdepending; 


INITIALIZE:  PROCEDURE; 

DECLARE  ( COUNT, WHERE, HOi#$MA\Y  ) ADDRESS 
BASE-.’iiHSRE; 

DO  1*0  TO  3? 

B$BYTS( I )*GET$CHAR? 

end; 


BASF-WH5R5  - 1» 

DO  COUNT  = 1 TO  hov*many; 

3$BYTE( C0UNT)*GET$C3AR; 

end; 

call  next*cear; 

END  INITIALIZE; 


BUILD:  PROCEDURE; 
DECLARE 


F2 

LIT 

'8\ 

F3 

LIT 

'9', 

F4 

LIT 

'21  \ 

F5 

LIT 

'24', 

F6 

LIT 

'32', 

F7 

LIT 

'39', 

F9 

LIT 

'49', 

Fie 

LIT 

'54', 

Fll 

LIT 

'60', 

F13 

LIT 

'61', 

GDP 

LIT 

'62'. 

INT 

LIT 

'63', 

3ST 

LIT 

'64', 

TER 

LIT 

'65', 

STP 

LIT 

'06  ', 

SCD 

LIT 

'66'; 

FOREVER  J 

IF  CHAR 

< F2 

THEN  CALL  STORE(l) J 

ELSE 

IF 

CHAR 

< 

F3  THEN  CALL  STCRE(2)5 

ELSE 

IF 

CHAR 

< 

F4  THEN  CALL  STORE (3); 

ELSE 

IF 

CHAR 

< 

F5  THEN  CALL  ST0R5(4); 

ELSE 

IF 

CHAR 

< 

F6  THEN  CALL  ST0RS(5); 

ELSE 

IF 

CHAR 

< 

?7  THEN  CALL  ST0RE(6)? 

ELSE 

IF 

CHAR 

< 

F9  THEN  CALL  STORE17)  ; 

ELSE 

IF 

CHAR 

< 

F10  THEN  CALL  STCRE'.9); 

ELSE 

IF 

CHAR 

< 

Fll  THEN  CALL  STORE! 10); 

ELSE 

IF 

CHAR 

< 

F13  THEN  CALL  STORE'vll ) ; 

ELSE 

I? 

CHAR 

< 

GDP  THEN  CALL  STORE! 13) J 

ELSE 

IF 

CHAR 

= 

GDP  THEN  CALL  GCSDEPENDING ; 

ELSF 

IF 

CHAR 

3 

BST  THEN  CALL  BACXSSTUFFJ 

ELSE 

IF 

CHAR 

3 

INT  THEN  CALL  INITIALIZE; 

ELSE 

IF 

CHAR 

3 

TER  THEN 

do; 

C*3YTE  * ST?? 

CALL  PMNT(  .(  'LOAD  FINISHED*  ')  ) J 
RETURN; 

end; 

ELSE  IF  CHAR  = SCD  THEN  CALL  START$CODS; 

ELSE  do; 

IF  CHAR  <>  0FFH  THEN 

CALL  PR  I NT ( . ( 'LOAD  ERROR*') )J 
CALL  next$char; 

end; 
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end; 

end  build; 


/*  PROGRAM  EXECUTION  STARTS  HERE  */ 

FCB$BTTE$A(32) ,FCB$BTTE=0; 

CALL  MCVE( . I 'CIN',0,0,0 ,0 ) ,FCB  ♦ 9,7)J 
IP  OPEN ( FCB )*255  THEN 

do; 

CALL  PRINT (.('FILE  NOT  FOUND  $'))? 

CALL  reboot; 
end; 

CALL  next$char; 
call  build; 

CALL  MOVE( .INT5RPA?CB,FCB,33) ; 

?CB$BTTE$A( 32  ) = 0; 

IF  OPEN ( FCB )»255  THEN 

do; 

CALL  PRINT( .( 'INTERPRETER  NOT  FOUND  $')); 

call  reboot; 

end; 

CALL  MCVS( READ3RSL0CATI0N , 80H , 80H); 

ADDR  * 60H;  CALL  ADDEJ  /*  BRANCH  TO  or T */ 

end; 


INTRDR : /*  NAME  OF  MODULE  */ 

do; 

/*  COBOL  COMPILER  - INTERP  READER  */ 

/*  THIS  PROGRAM  IS  CALLED  BY  THE  BUILD  PROGRAM  AFTER 
CINTERP.COM  HAS  BEEN  OPENED,  AND  READS  THE  CODE  INTO 
MEMORY  */ 


/*  80E  - LOAD  POINT  */ 

DECLARE 

START  LITERALLY  '100H',  /*  STARTING  LOCATION  FOR 

PART2  */ 

INTERP  ADDRESS  IN ITI AL ( START) , 

I ADDRESS  INITIAL  (0080H); 

MONA:  PROCEDURES, A)  J 

DECLARE  F BYTE,  A ADDRESS; 

L:00  TO  L;  /*  PATCH  TO  ->  JMP 

END  mona; 

M0NB : PP0CSDURE(F, A) BYTE! 

DECLARE  F BYTE,  A ADDRESS; 

BDOS 

V 

L:GC  TO  L;  /*  PATCH  TO  ->  "JMP 

RETURN  0?  /*  ZAP  ->  "NO-OP" 

END  monb; 

DO  •HILE  1? 

bdos” 

V 

*/ 

CALL  MONA  (26,  ( I :-I +0080H ) ) ; /* 
IF  MONB  (20,  5CH)  <>  0 THEN 

SET  DMA 

ADDRESS 

CALL  INTER?? 

END* 


END? 
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DECODE:  DO* 


/*  THIS  PROGRAM  TAKES  THE  CODE  OUTPUT  FROM  THE  COBOL 
COMPILER  AND  CONVERTS  IT  INTO  A READABLE  OUTPUT  TO 
FACILITATE  DEBUGGING  V 


/*  * * 100H:  LOAD  POINT  */ 


DECLARE 


LIT 

LITERALLY 

'LITERALLY', 

BOOT 

LIT 

BDOS 

LIT 

'5', 

FCB 

ADDRESS 

INITIAL  ( 5CH ) 

FCB$BTTS 

BASED  FCB 

(1)  BYTE, 

I 

BYTE. 

ADDR 

ADDRESS 

INITIAL  ( 100H 

BYTEtCOUNT 

ADDRESS 

INITIAL  (0), 

BYTSSLOW 

BYTE, 

BYTE$HI 

BYTE, 

CHAR 

BASED  ADDR 

BYTE, 

C$ADDR 

BASED  ADDR 

ADDRESS, 

BUFFSEND 

LIT 

'0FFH ' , 

FILEtTYPE  (*) 

BYTE  DATA 

('c','i','n'); 

» 


MCN1:  PROCEDURE  (F, A ) J 

DECLARE  F BYTE,  A ADDRESS; 

L:  GO  TO  L?  /*  PATCH  TO  JMP  5 */ 

END  MON1 ; 


M0N2:  PROCEDURE  (F,A ) BYTE? 

DECLARE  F BYTE,  A ADDRESS; 

L:GO  TO  L;  /*  * * PATCH  TO  ’*  JMP  5 " * * */ 

RETURN  0; 

END  M0N2J 


PRINTiCHAR:  PRCCEDURS(CHAR) ; 
DECLARE  CHAR  BYTE? 

CALL  MON1 ( 2, CHAR ) ; 

END  PRINT5CHAR; 


CRLF : PROCEDURE; 

CALL  ?RINT$CHAR(13) J 
CALL  ?RINT$CHAR(10) ; 
END  cplf; 


P:  PRCCEDURE(ADDl); 

DECLARE  ADD1  ADDRESS,  C BASED  ADD1  (1)  BYTE*. 

call  crlf; 

DO  1*0  TO  2,* 
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CALL  PPINT$CEAR(C( I) ) ; 

end; 

CALL  PRINT$CHAR(  ' '); 

END  p; 

GET$CHAR : PROCEDURE  BYTE? 

IF  ( ADDR:*ADDR  + 1)>BUFF$SND  THEN 

do; 

IF  M0N2 ( 20 , FCB )<>0  THEN 

do; 

CALL  P( .(  'END')  ); 

CALL  TIME(10); 

L:  GO  TO  L;  /*  PATCH  TO  JMP  000? 

end; 

ADDR=80H* 

fnd; 

RETURN  CHAR; 

END  get$char; 


D$CHAR:  PROCEDURE  (OUTPUTSBTTE ) J 
DECLARE  OUTPUT$BYTE  BYTE; 

IF  OUTPUT* BYTE<10  THEN 
CALL  PP.  INT$CH»R(  OUT  PUT  $ BYTE  + 30H)J 
ELSE  CALL  PR  I NT* CHAR ( OUTPUTS  BYTE  + 37H  ) ; 
END  d$char; 


D:  PROCEDUFE  ( COUNT); 

DECLARE ( COUNT  f J ) ADDRESS; 

DO  J=1  TO  COUNT; 

CALL  D$CEAR ( SHR( GETS  CHAR  ,4  ) ) J 
CALL  DSCHAR( CHAR  AND  0FH)J 
CALL  ?RINT$CHAR(  ' '),* 

end; 

END  d; 


PPINTSREST:  PROCEDURE; 


DECL 

ARE 

F2 

LIT 

'8' 

F3 

LIT 

'9' 

F4 

LIT 

'21 

F5 

LIT 

'23 

F6 

LIT 

'32 

F7 

LIT 

'39 

F9 

LIT 

'49 

F10 

LIT 

'54 

Fll 

LIT 

'60 

F13 

LIT 

'61 

GDP 

LIT 

'62 

INT 

LIT 

'63 

3ST 

LIT 

'64 

TER 

LIT 

'65 

*/ 
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scr  LIT  '66'; 


IF  CHAR  < F2  THEN  RETURN? 

IF  CHAR  < F3  THEN  DO?  CALL  D(l)?  RETURN?  END? 

IF  CHAR  < F4  THEN  DO?  CALL  D ( 2 ) ? RETURN?  END? 

IF  CHAR  < F5  THEN  DO?  CALL  D(3)?  RETURN?  END? 

IF  CHAR  < F6  THEN  DO?  CALL  D(4)?  RETURN?  END? 

IF  CHAR  < F7  THEN  DO?  CALL  D(5)f  RETURN?  END? 

IF  CHAR  < F9  THEN  DO?  CALL  D (6 ) ? RETURN?  END? 

IF  CHAR  < F10  THEN  DC?  CALL  D(8)?  RETURN?  END? 

IF  CHAR  < Fll  THEN  DO?  CALL  D(9)?  RETURN?  END? 

IF  CHAR  < FI 3 THEN  DO?  CALL  D(10)?  RETURN?  END? 

IF  CHAR  < GrP  THEN  DO?  CALL  Dl 12 ) ? RETURN?  END? 

IF  CHAP=GD?  THEN  DO? 

CALL  D(l);  CALL  D ( SHL( CHAR , 1 ) +5 ) ? RETURN?  END? 

IF  CHAR  = INT  THEN 
DO? 

BYTE$COUNT  = 0? 

CALL  D(3)? 

BYTE$LOW  = CHAR? 

CALL  D(l); 

3YT3$HI  = CHAR? 

BYTE$COUNT  = BYTE4HI? 

BYTE$COUNT  = SHL (B YTE$COUNT ,8 ) «■  BYTE$LOW? 
CALL  D(BYTE$COUNT) ? 

RETURN? 

END? 

IF  CHAR=BST  THEN  do;  CALL  D( 4 ) ? RETURN?  END? 

IF  CHAR=TER  THEN  DO?  CALL  P(.('SND'))? 

L:  GO  TO  L?  /*  PATCH  TO  'JMP  0*  * * */  END? 

I?  CHAR*SCE  THEN  DO?  CALL  DC  2 ) 5 RETURN?  END? 

IF  CEAF.  <>  0FFH  THEN  CALL  P(.(#XXX'))? 

END  ?RINT$REST  ? 


/*  PROGRAM  EXECUTION  STARTS  HERE  */ 


FCB$BYTE(32 ) , ?CB$3YTE(0)  = 0? 
DO  1*0  TO  2? 

?CB£BYTE( 1+9 ) *FILE$TYPE( I ) ? 

END? 


IF  M0N2 ( 15, FCB )=255  THEN  DO?  CALL  P(.('ZZZ'))? 

Ls  GO  TO  L?  END? 

/*  * * * PATCH  TO  "JMP  BOOT"  * * * 

DO  WHILE  1? 

IF  GST$CHAR  <=  66  THEN  DO  CASE  CHAR? 

? /*  CASS  0 NOT  USED  */ 

CALL  Pi  .(  'ADD')  )? 

CALL  P(.rsUB')  )? 

CALL  P( . ( 'MUL ')  )? 

CALL  P( . ( 'DI7')  )? 

CALL  P(.(  'NEG')  )? 
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CALL  ?(.( 'STP')  ) 
CALL  P(.l'STI')  ) 
CALL  P(.(  'RND') ) 
CALL  P(  .(  'RET')  ) 
CALL  PU('CLS')  ) 
CALL  P(  .(  'SER')  ) 
CALL  P(.('BRN')  ) 
CALL  P(.('OPN')  ) 
CALL  P( .(  'OP1')  ) 
CALL  P ( . ( '0P2  ')  ) 
CALL  P ( . ( 'RGT  ' ) ) 
CALL  P( .(  'RLT')  ) 
CALL  P( . ( 'REQ')  ) 
CALL  P(.  ( 'INV')  ) 
CALL  P( .(  'EOR ' ) ) 
CALL  P( .( 'ACC')  ) 
CALL  P( . ( 'STD')  ) 
CALL  P( . ( 'LDI  ')  ) 
CALL  P(  .(  'DIS')  ) 
CALL  P( .(  'DEC')  ) 
CALL  P( .(  'STO')  ) 
CALL  ?(.(  'ST1 ' ) ) 
CALL  P;.(  'ST2')  ) 
CALL  P( . ( 'ST3'  ) ) 
CALL  P( . ( 'ST4')  ) 
CALL  P( .( 'ST5')  ) 
CALL  P(.(  'LOD')  ) 
CALL  ?(  .(  'LDI')  ) 
CALL  P(. ( 'LD2 ' ) ) 
CALL  P( .(  'LD3  ' ) ) 
CALL  P( . ( 'LDO  ) 
CALL  P(.(  'LD4')  ) 
CALL  P( .(  'LD6' ) ) 
CALL  P( . ( 'PER')  ) 
CALL  P(.(  'CNU')  ) 
CALL  P(  .(  'CNS  ' ) ) 
CALL  P( .( 'CAL')  ) 
CALL  P( . ( 'RWS  ' ) ) 
CALL  P ( . ( 'DLS  ' ) ) 
CALL  P( .(  'RDF')  ) 
CALL  P(.l'WTF')) 
CALL  P( .(  'RVL')  ) 
CALL  ?( .(  'WTL')  ) 
CALL  ?(.(  'SCR')  ) 
CALL  P( .( 'S3T') ) 
CALL  P( . ( 'SLT')  ) 
CALL  P( .(  'SEQ')  ) 
CALL  P(.(>07')  ) 
CALL  P( . ( 'RRS  ' ) ) 
CALL  P(.l'WRS')) 
CALL  P(  . ( 'RRR ' ) ) 
CALL  ?(  A 'WRR' ) ) 
CALL  P(.(  'RWR') ) 
CALL  P(.('DLR')) 


CALL  P( .( 'MED')  )J 
CALL  P( .( 'MNE') ); 

CALL  P( .(  'GDP')  )J 
CALL  P(.(  'INT')  )J 
CALL  P(.('BST')); 

CALL  P ( . ( 'TER' ) )J 
CALL  P(.(  'SCD')  )J 
end;  /*  OF  CASE  STATEMENT  */ 
CALL  PRlNTiREST; 

END;  /*  END  OF  DO  WHILE  */ 
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